LinkBack URL
About LinkBacks
from vertical, in horizontal , automatically
from vertical, in horizontal , automatically
Hi lomanosa,
. I have a code that i think does the job for you...
A few important assumptions..
.1) in sheet 2 the names list is complete and names are unique there.
.2) name spellings in both sheets must be identical
.3) occurrences are always listed in pairs with regard to date, that is to say a start and stop date
. 4) All dates from sheet 1 are to be found on sheet 2 ( Which would be the case in a real file with all year dates, as you indicated )
. 5) I assume the output sheet 2 initially has no data entries,
. 6) I assume the output sheet initially has the names list in column1 and all dates in row 1
..... I modified your test data to fit it on screen and demonstrate better: I added George Hjipieris, a Greek I happen to know who is a perpetual Wanker.
So this would be your Data for input from sheet 1
Using Excel 2007
Row\Col name James holiday John half day holiday James leiu day Richard half leiu day Richard sick George TFMTC Wanking Hjipieris TFMTC Wanking
F????1
.. I assume as noted in . 5) and . 6) that only the names column 1 and first row Dates are present initially. Then after running the code with the above sheet 1 Data you get this in the second sheet
Using Excel 2007
Row\Col name James holiday holiday holiday holiday holiday leiu day leiu day leiu day John half day holiday half day holiday half day holiday Richard sick sick half leiu day half leiu day half leiu day Ptang PTang OLE Wiggy Wam Biscuit Barrel Du WollyWop George Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Hjipieris Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking Wanking
F????2
..........
. The code for the above ( Sub gelomanosaDonkeyWanks() ) I present in the next Post, #3
Last edited by Doc.AElstein; 08-18-2015 at 07:16 PM. Reason: Wanking a bit more until my plonker falls off
'_- Google first, like this _ site:ExcelForum.com Gamut
Use Code Tags: Highlight code; click on the # icon above,
Post screenshots COPYABLE to a Spredsheet; NOT IMAGES PLEASE
http://www.excelforum.com/the-water-...ml#post4109080
https://app.box.com/s/gjpa8mk8ko4vkwcke3ig2w8z2wkfvrtv
http://excelmatters.com/excel-forums/ ( Scrolll down to bottom )
Code ( gelomanosaDonkeyWanks() ) to give the results discussed in Post #2
Option Explicit Sub gelomanosaDonkeyWanks() On Error GoTo TheEnd 'This is a general Error handler. Go to spring point TheEnd: after error occurs Rem 1 Some Worksheet Info and Data getting Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets.Item(2) 'Second Sheet in Tab' Give variables Method, Properties etc, of Worksheets Object. These lines allow lets VBA recognise them as objects such that you get with intellisense a selection of Proerties, Methods etc through typing .Dot'Give abbreviation all Mehtods and Properties of Worksheets Object through .Dot Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets.Item(1) 'First sheet in Tab Dim r1 As Long, r2 As Long, c2 As Long, c1 As Long 'Variable for "rows" and "columns", used as Loop Bound variable Count variables. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr2 As Long: Let lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr1 As Long: Let lr1 = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Effecively looking for anything, by rows, starting at the first cell and going backwards, which effectively starts at the end of the Sheet.( This allows for different XL versions. It completes a serch of one complete cycle. Returns the last row rathher in any column rather than the last row in a particular column. Just an alternative method. Dim lc2 As Long: Let lc2 = ws2.Cells.Find(What:="*", After:=ws2.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column Dim arrIn() As Variant 'This will become an Array of all Info from first sheet some of which be copied across depending on criteria - must be given variant dimension to allow the range assignment that will become an Array in the next VBA allowed "one liner" - It "becomes an Array" as VBA guesses that is what should be returned. But as it recives a range Object initially which could be anything it must be Variant Let arrIn() = ws1.Range("A1:E" & lr1 & "").Value2 'The Property .value 2 applied to a range of more than 1 cell returns a colllection ( Array ) of the undelying values all the cells in that range. VBA allows a "one liner" to then assign these value to a dynamic Array. The Elements of the collection are defined initially as variant by VBA. So that is why we had Array() = Variant Dim arrYear() As Variant: Let arrYear() = ws2.Range("B1", ws2.Cells(1, lc2)).Value2 '1 row two dimensional Arra of Dates Range in second sheet Dim arrNames() As Variant: Let arrNames() = ws2.Range("A2:A" & lr2 & "").Value2 'Assume all Names in a Unique list are given in second sheet column A Dim stDtMt As Long, stpDtMt As Long 'Variable for indicies of start and stop dates Matches in sheet 2 of occurances. Rem 2 Loop to make output data array Dim arrOut() As String: ReDim arrOut(1 To UBound(arrNames(), 1), 1 To lc2 - 1) 'We know the dimensions required for our Output Data, and will be filling in individual elemnts in looping so can use a dimensioned non dynamic Array and as such may give its ements a suitablke type For r2 = 1 To UBound(arrNames(), 1) Step 1 'Outermost Loop. Everything is done for each Unique name, so we intend "looking" down "column" 1 (name) For r1 = 2 To UBound(arrIn(), 1) Step 1 'With Unique name check for name match If arrNames(r2, 1) = arrIn(r1, 1) Then 'Name match so then begin investigating in next lines any entries agains that name On Error Resume Next 'This is a tempory error handler statement. When passing this the main error handler is overwritten. We want this to catch the errors in Application.Match which will occur if no date match is found If Application.Match(arrIn(r1, 2), arrYear(), 0) = -1234 And Application.Match(arrIn(r1, 3), arrYear(), 0) = -1234 Then 'This value will never be achieved. Nut it is a valid long number for Allication.match to return. As long as both conditions return a valid number we go to Else, otherwise we error. If we error then because of the error hander, the error is surpressed and we carry on as if no error had occurred at the next line MsgBox ("Problem with dates, program will stop") On Error GoTo 0 'This is not really nercerssary as we stop the sub now. But good practice. Both this statement and stoping the sub disable this error handler and On Error GoTo TheEnd '.. Puts back on the general one. Again not necerssary here but good to get into this habit. Exit Sub 'Stop program Else 'We come here after no erro in Application.Match so have valid indicies for date row match ( But not -1234 ) Let stDtMt = Application.Match(arrIn(r1, 2), arrYear(), 0): Let stpDtMt = Application.Match(arrIn(r1, 3), arrYear(), 0) 'BTW Match returns indicie "along" the second argument Array at which the first argument string value is found. = means an excact match http://www.excelforum.com/excel-programming-vba-macros/1098104-vba-application-match-not-working.html For lc2 = stDtMt To stpDtMt Step 1 'This does for the duration of the date pair occurance Let arrOut(r2, lc2) = arrIn(r1, 5) 'Across the date span the occurrance type is put in Next lc2 On Error GoTo 0 'Good practice. switch tempory Error handler off and... On Error GoTo TheEnd '..Put the general one on. End If Else 'Case No name match, ready to go to next sheet 2 "row". No Action taklen here. Redundant Code End If Next r1 Next r2 Rem 5 Output to sheet Let ws2.Range("B2").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value2 = arrOut() 'Neat way to paste out in one go: Resize the range ( cell ) at top left of where output data should go to size of output array, then use the allowed VBA "One liner" to assign the values of an array to a spreadsheet range. TheEnd: 'Anything that should always be done before the code stops running (even if an error occours) should be put here: End Sub
Thank Doc.AElstein to answer , can the code to put it in a excel file???
Hi,Originally Posted by manos77
. Just to update everyone. You supplied me per PM and Email a new file Yesterday and asked for help as you were having difficulty logging in to Excel Forum .
......................................
So you changed your input to this: (showing also the new test data you included )
Using Excel 2007
Row\Col James
DB
..and here is part of your output, ( again showing the hand filled in results you wrote to indicate what you wanted the code to do. )
Using Excel 2007
Row\Col condition CAUSE OF ABSENCE CAUSE OF ABSENCE CAUSE OF ABSENCE Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday Half Day Holiday
DATA PLAN
... so you have a new requirement and need a new code, or the existing one modified quite a bit. Never less the changes are fairly simple so it may be considered a follow up to this Thread.
. I have therefore written the following code for you which appears to meet the new requirements.
. I have tested it with the limited test data you gave and it reproduces your hand filled in output results.
Alan
P.s.
Note: There were some issues with different date formats in your two sheets. It is impossible for me at this distance to advise specifically on this considering our different land conventions. You will simply have to try to maintain consistent date formats in those two sheets, as dates are compared for a match in the code , and errors may occur if formats are different.
Code , ( Sub gelomanosaDonkeyWanks2(), I give in next Post
Code ( Sub gelomanosaDonkeyWanks2() ) for last Post, Post # 5
Option Explicit Sub gelomanosaDonkeyWanks2() On Error GoTo TheEnd 'This is a general Error handler. Go to spring point TheEnd: after error occurs Rem 1 Some Worksheet Info and Data getting Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("DATA PLAN") 'Second Sheet in Tab' Give variables Method, Properties etc, of Worksheets Object. These lines allow lets VBA recognise them as objects such that you get with intellisense a selection of Proerties, Methods etc through typing .Dot'Give abbreviation all Mehtods and Properties of Worksheets Object through .Dot Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("DB") 'First sheet in Tab Dim r1 As Long, r2 As Long, c2 As Long, c1 As Long 'Variable for "rows" and "columns", used as Loop Bound variable Count variables. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr2 As Long: Let lr2 = ws2.Cells(Rows.Count, 8).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr1 As Long: Let lr1 = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Effecively looking for anything, by rows, starting at the first cell and going backwards, which effectively starts at the end of the Sheet.( This allows for different XL versions. It completes a serch of one complete cycle. Returns the last row rathher in any column rather than the last row in a particular column. Just an alternative method. Dim lc2 As Long: Let lc2 = ws2.Cells.Find(What:="*", After:=ws2.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'Used for last column Dim arrIn() As Variant 'This will become an Array of all Info from first sheet some of which be copied across depending on criteria - must be given variant dimension to allow the range assignment that will become an Array in the next VBA allowed "one liner" - It "becomes an Array" as VBA guesses that is what should be returned. But as it recives a range Object initially which could be anything it must be Variant Let arrIn() = ws1.Range("B5:G" & lr1 & "").Value2 'The Property .value 2 applied to a range of more than 1 cell returns a colllection ( Array ) of the undelying values all the cells in that range. VBA allows a "one liner" to then assign these value to a dynamic Array. The Elements of the collection are defined initially as variant by VBA. So that is why we had Array() = Variant Dim arrYearAtts() As Variant: Let arrYearAtts() = ws2.Range("AU2", ws2.Cells(3, lc2)).Value2 '2 row two dimensional Arra of Dates and Attributes Range in second sheet Dim arrYear() As Variant: Let arrYear() = Application.WorksheetFunction.Index(arrYearAtts(), 1, 0) 'Returns format type (1,1) (1,2) (1,3) .... >> Index Function with third argument ("column" co - ordinate) set to 0 will return the entire row given by second argument ( row - co ordinate ), applied to the first argument which is the grid, ( Array , Row_Number, Column_Number) http://www.excelforum.com/excel-new-users-basics/1080634-vba-1-dimensional-horizontal-and-vertical-array-conventions-ha-1-2-3-4-a.html Dim arrNames() As Variant: Let arrNames() = ws2.Range("H4:H" & lr2 & "").Value2 'Assume all Names in a Unique list are given in second sheet column A Dim stDtMt As Long, stpDtMt As Long 'Variable for indicies of start and stop dates Matches in sheet 2 of occurances. Rem 2 Loop to make output data array Dim arrOut() As String: ReDim arrOut(1 To UBound(arrNames(), 1), 1 To lc2 - 46) 'We know the dimensions required for our Output Data, and will be filling in individual elemnts in looping so can use a dimensioned non dynamic Array and as such may give its ements a suitable type For r2 = 1 To UBound(arrNames(), 1) Step 1 'Outermost Loop. Everything is done for each Unique name, so we intend "looking" down "column" 1 (name) For r1 = 2 To UBound(arrIn(), 1) Step 1 'With Unique name check for name match If arrNames(r2, 1) = arrIn(r1, 6) Then 'Name match so then begin investigating in next lines any entries agains that name On Error Resume Next 'This is a tempory error handler statement. When passing this the main error handler is overwritten. We want this to catch the errors in Application.Match which will occur if no date match is found If Application.Match(arrIn(r1, 1), arrYear(), 0) = -1234 And Application.Match(arrIn(r1, 2), arrYear(), 0) = -1234 Then 'This value will never be achieved. Nut it is a valid long number for Allication.match to return. As long as both conditions return a valid number we go to Else, otherwise we error. If we error then because of the error hander, the error is surpressed and we carry on as if no error had occurred at the next line MsgBox ("Problem with dates, program will stop") On Error GoTo 0 'This is not really nercerssary as we stop the sub now. But good practice. Both this statement and stoping the sub disable this error handler and On Error GoTo TheEnd '.. Puts back on the general one. Again not necerssary here but good to get into this habit. Exit Sub 'Stop program Else 'We come here after no error in Application.Match so have valid indicies for date row match ( But not -1234 ) Let stDtMt = Application.Match(arrIn(r1, 1), arrYear(), 0) + 1: Let stpDtMt = Application.Match(arrIn(r1, 2), arrYear(), 0) + 1 ' +1 because "CAUSE OF ABSENCE" is offset +1 from first dtate match BTW Match returns indicie "along" the second argument Array at which the first argument string value is found. = means an excact match http://www.excelforum.com/excel-programming-vba-macros/1098104-vba-application-match-not-working.html For c2 = stDtMt To stpDtMt Step 3 'This does for the duration of the date pair occurance Let arrOut(r2, c2) = arrIn(r1, 5) 'Across the date span the occurrance type is put in Next c2 On Error GoTo 0 'Good practice. switch tempory Error handler off and... On Error GoTo TheEnd '..Put the general one on. End If Else 'Case No name match, ready to go to next sheet 2 "row". No Action taklen here. Redundant Code End If Next r1 Next r2 Rem 5 Output to sheet Let ws2.Range("AU4").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value2 = arrOut() 'Neat way to paste out in one go: Resize the range ( cell ) at top left of where output data should go to size of output array, then use the allowed VBA "One liner" to assign the values of an array to a spreadsheet range. TheEnd: 'Anything that should always be done before the code stops running (even if an error occours) should be put here: End Sub
Last edited by Doc.AElstein; 08-28-2015 at 07:15 AM.
Thank Doc.AElstein, your code can get into the excel file that sends your
I do not know , will help too.
. ? I not do can understand you is difficult. I sorry not in Greek talk is not my to speak language.
. Do you help want still like have to ?
. Do you difficulty still having
. My code you good is working?..
.. or
. You not my code to work make kann it?
Alan
........
.Let me guess kann maybe..
. You want File back with code in.. You too not good to do that can is
I was wrong to date .
The date will be the same on both sheets .
YES. I Want file back with code in. Thanks.
Hi,
. File I here do attached have done you for is ( SpoonFeedADonkeyWanks.xlsm )
. Note: I do must haved to date Format changed is. It may Greek Wolly will not work . You check change if experiment say that do to work then is will ( Must maybe is . enit? )
. Please do say if work good for you is ( or not ! )
..
Using Excel 2007
Row\Col James George
DB
Using Excel 2007
Row\Col condition CAUSE OF ABSENCE CAUSE OF ABSENCE Half Day Holiday Half Day Holiday Wanking Wanking
DATA PLAN
( George is Wanking again ! )
...................................
Alan
What changes should I make to the office to work
Hi.
. 1 ) Changing the Office to encourage a nice Working Atmosphere.
. You could bring some Flowers in, maybe.
. Hang some nice Pictures on the wall
................................................
.2 ) Date Format issues
.
. 2a) File I did you give to have already, I did put correct matching format in has for you , .
. Should be ? Enit?
.
. By me works still does me good File
OR:
. 2b) You make must:
Date Format Sheet “DATA PLAN” - Row 2 ( AU2 : AQW2 )
same as Date format for
Date Format sheet “DB” - Range B6 : C11
....Enit ?
.Alan
google translate
It does not help to laugh
p.s 1 we in this forum (Non English Excel) do not forget
p.s 2 your code does not work
p.s 3 Thank you for your time
Alan translation ( Try do )
. Laughing always good is?Healthy is
. File and code here work still do
. You want not working File send do ? – Then I check it later ?
. If Not. Sorry I no help Better did. ( I very hard try did!! )
. I try best. All Codes I do work have always.
. Problem maybe Greek Excel Different is??
. Alan
P.s.1. Google translate very badly is. You no friends that English speak to help can ?
p.s. 2. Let me try guess again:
You want code start when you date type in?? You must try better to explain exactly what you want.
. - Then you send file back . - I did do normal code. I try can it change to a "Worksheet_Change code"
.
. This code MUST go in WORKSHEETS “DB” Module, to be there enit?
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'THIS CODE MUST GO IN WORKSHEETS "DB" MODULE On Error GoTo TheEnd 'This is a general Error handler. Go to spring point TheEnd: after error occurs ' Rem 1 Some initial sheet data refferencing. NOTE: All unqualified Range referrences out to this sheet ( assuming the code in in a Sheet Module Dim rngSel As Range: Set rngSel = Range("B6", "G11") 'Restrict our User input Range to the Date Range Rem 2 This starts the main program under certain conditions If Intersect(rngSel, Target) Is Nothing Then 'Check to see if the change did not occur on the intersection between the Range specified and that range actually changed. Target is the Range object corrersponding to the Range in which the change occured 'MsgBox ("That was not an entry in selection Range")'Possibility to give warning before leaving Sub quickly before doing anything GoTo TheEnd 'Go to End of Code ElseIf Target.Column = 2 And Target.Offset(0, 1).Value = "" Then 'Case typed in Initial date but have no Final Date GoTo TheEnd 'Go to End of Code ElseIf Target.Column = 3 And Target.Offset(0, -1).Value = "" Then 'Case typed in Final Date but have no Initial Date GoTo TheEnd 'Go to End of Code Else 'Presumably an acceptable change occured in the Range of interest so the main code below starts Rem 2a Some Worksheet Info and Data getting Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("DATA PLAN") 'Sheet DATA Plan Give variables Method, Properties etc, of Worksheets Object. These lines allow lets VBA recognise them as objects such that you get with intellisense a selection of Proerties, Methods etc through typing .Dot'Give abbreviation all Mehtods and Properties of Worksheets Object through .Dot Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("DB") 'Sheet DB' NOTE For this Code you do not need to qualify ws1 if code is in sheet "DB" Dim r1 As Long, r2 As Long, c2 As Long, c1 As Long 'Variable for "rows" and "columns", used as Loop Bound variable Count variables. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr2 As Long: Let lr2 = ws2.Cells(Rows.Count, 8).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lr1 As Long: Let lr1 = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'Effecively looking for anything, by rows, starting at the first cell and going backwards, which effectively starts at the end of the Sheet.( This allows for different XL versions. It completes a serch of one complete cycle. Returns the last row rathher in any column rather than the last row in a particular column. Just an alternative method. Dim lc2 As Long: Let lc2 = ws2.Cells.Find(What:="*", After:=ws2.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'Used for last column Dim arrIn() As Variant 'This will become an Array of all Info from first sheet some of which be copied across depending on criteria - must be given variant dimension to allow the range assignment that will become an Array in the next VBA allowed "one liner" - It "becomes an Array" as VBA guesses that is what should be returned. But as it recives a range Object initially which could be anything it must be Variant Let arrIn() = ws1.Range("B5:G" & lr1 & "").Value2 'The Property .value 2 applied to a range of more than 1 cell returns a colllection ( Array ) of the undelying values all the cells in that range. VBA allows a "one liner" to then assign these value to a dynamic Array. The Elements of the collection are defined initially as variant by VBA. So that is why we had Array() = Variant Dim arrYearAtts() As Variant: Let arrYearAtts() = ws2.Range("AU2", ws2.Cells(3, lc2)).Value2 '2 row two dimensional Arra of Dates and Attributes Range in second sheet Dim arrYear() As Variant: Let arrYear() = Application.WorksheetFunction.Index(arrYearAtts(), 1, 0) 'Returns format type (1,1) (1,2) (1,3) .... >> Index Function with third argument ("column" co - ordinate) set to 0 will return the entire row given by second argument ( row - co ordinate ), applied to the first argument which is the grid, ( Array , Row_Number, Column_Number) http://www.excelforum.com/excel-new-users-basics/1080634-vba-1-dimensional-horizontal-and-vertical-array-conventions-ha-1-2-3-4-a.html Dim arrNames() As Variant: Let arrNames() = ws2.Range("H4:H" & lr2 & "").Value2 'Assume all Names in a Unique list are given in second sheet column A Dim stDtMt As Long, stpDtMt As Long 'Variable for indicies of start and stop dates Matches in sheet 2 of occurances. Rem 1b Loop to make output data array Dim arrOut() As String: ReDim arrOut(1 To UBound(arrNames(), 1), 1 To lc2 - 46) 'We know the dimensions required for our Output Data, and will be filling in individual elemnts in looping so can use a dimensioned non dynamic Array and as such may give its ements a suitable type For r2 = 1 To UBound(arrNames(), 1) Step 1 'Outermost Loop. Everything is done for each Unique name, so we intend "looking" down "column" 1 (name) For r1 = 2 To UBound(arrIn(), 1) Step 1 'With Unique name check for name match If arrNames(r2, 1) = arrIn(r1, 6) Then 'Name match so then begin investigating in next lines any entries agains that name On Error Resume Next 'This is a tempory error handler statement. When passing this the main error handler is overwritten. We want this to catch the errors in Application.Match which will occur if no date match is found If Application.Match(arrIn(r1, 1), arrYear(), 0) = -1234 And Application.Match(arrIn(r1, 2), arrYear(), 0) = -1234 Then 'This value will never be achieved. Nut it is a valid long number for Allication.match to return. As long as both conditions return a valid number we go to Else, otherwise we error. If we error then because of the error hander, the error is surpressed and we carry on as if no error had occurred at the next line MsgBox ("Problem with dates, program will stop") On Error GoTo 0 'This is not really nercerssary as we stop the sub now. But good practice. Both this statement and stoping the sub disable this error handler and On Error GoTo TheEnd '.. Puts back on the general one. Again not necerssary here but good to get into this habit. Exit Sub 'Stop program Else 'We come here after no error in Application.Match so have valid indicies for date row match ( But not -1234 ) Let stDtMt = Application.Match(arrIn(r1, 1), arrYear(), 0) + 1: Let stpDtMt = Application.Match(arrIn(r1, 2), arrYear(), 0) + 1 ' +1 because "CAUSE OF ABSENCE" is offset +1 from first dtate match BTW Match returns indicie "along" the second argument Array at which the first argument string value is found. = means an excact match http://www.excelforum.com/excel-programming-vba-macros/1098104-vba-application-match-not-working.html For c2 = stDtMt To stpDtMt Step 3 'This does for the duration of the date pair occurance Let arrOut(r2, c2) = arrIn(r1, 5) 'Across the date span the occurrance type is put in Next c2 On Error GoTo 0 'Good practice. switch tempory Error handler off and... On Error GoTo TheEnd '..Put the general one on. End If Else 'Case No name match, ready to go to next sheet 2 "row". No Action taklen here. Redundant Code End If Next r1 Next r2 Rem 2c Output to sheet ws2.Activate 'Application.EnableEvents = False'This is not really needed here as we not accessing this sheet. Let ws2.Range("AU4").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value2 = arrOut() 'Neat way to paste out in one go: Resize the range ( cell ) at top left of where output data should go to size of output array, then use the allowed VBA "One liner" to assign the values of an array to a spreadsheet range. 'Application.EnableEvents = True End If 'This is the end of the main program run for the correct selection conditions Rem 3 TheEnd: 'Anything that should always be done before the code stops running (even if an error occours) should be put here: Application.EnableEvents = True End Sub
Using Excel 2007
Row\Col James George
DB
Using Excel 2007
Row\Col condition CAUSE OF ABSENCE CAUSE OF ABSENCE CAUSE OF ABSENCE Half Day Holiday Half Day Holiday Half Day Holiday Wanking Wanking
DATA PLAN
Alan.
P.s. I do guess you file want have “SpoonFeedAWanka_Change.xlsm” ? I test therein did it good.
Last edited by Doc.AElstein; 09-02-2015 at 11:10 AM.
google translate
When I go to Inicial Date-Final Date-Days-Obs I go to the next sheet, I want to go to me only when I give the name
google translate
SpoonFeedADonkeyWanks
gelomanosaDonkeyWanks
is not Healthy
p.s I do something wrong
p.s Thank you sincerely
SpoonFeedAWanka_Change.xlsm ?????
who is????
alan translate.
. No you good wanks is healthy. Try it.
. Then Wank George another Day in Sheet “DB”..
Attachment 416963
.... then George Wanks across Sheet “DATA PLAN”
Attachment 416964
.. Now had good healthy Wank with George ?
google translate
perfect
Thank you very much
change columns
Hi manos
As ever communication in English is difficult for you.
Η επικοινωνία στα αγγλικά είναι δύσκολη για εσάς
So it is very difficult to understand what you want
Γι 'αυτό είναι πολύ δύσκολο να καταλάβεις τι θέλεις
Google translate not too good is
Η μετάφραση του Google δεν είναι πολύ καλή
Also you often do not give us enough information
Επίσης, συχνά δεν μας δίνετε αρκετές πληροφορίες
_....................
_.____________________________-
I am guessing this is the same request that you asked here: ** Duplicate post: https://www.excelforum.com/excel-pro...ml#post4684017
You included a File in that duplicated post, so it is more understandable what you want.
I think xladept has given you the answer:
As he suggested, this code line_....
_... in conjunction with this code line_...Dim rngSel As Range: Set rngSel = Range("A2", "F1500")
_...determines the range which will set off the Events triggered code, _ ( Sub Worksheet_Change(ByVal Target As Range) )If Intersect(rngSel, Target) Is Nothing Then
So , for example, if you change to_...
_....Dim rngSel As Range: Set rngSel = Range("F2", "F7")
then only the range F2:F7 will set of the Events triggered code, _ ( Sub Worksheet_Change(ByVal Target As Range) )
manos2017.JPG http://imgur.com/9x4KHWB
manos2017.JPG
Using Excel 2007 32 bit
Worksheet: DB
Row\Col James
_......
_._______________________________
Note:
You must not
Δεν πρέπει να
_ 1 Duplicate Post **
Ask same question in many Threads
Ρωτήστε την ίδια ερώτηση σε πολλά Threads
_2 Cross post without URL link to other Forums where you have cross posted.
Εσυ πρεπει:Δώστε σύνδεση URL Για όλες τις ερωτήσεις σας σε διαφορετικά μέρη
Alan
Last edited by Doc.AElstein; 06-26-2017 at 05:13 AM.
google translate
Doc.AElstein thank you.
I did the same question in other Threads, because the answer was delayed. sorry
Hi manos
For, feedback, thank you
Για, ανατροφοδότηση, ευχαριστώ
It is also good to thank xladept. https://www.excelforum.com/excel-pro...ml#post4684021
Καλό είναι επίσης να ευχαριστήσω το xladept https://www.excelforum.com/excel-pro...ml#post4684021
_..
Please also:
Παρακαλώ επίσης:
You should: Give a URL link For all your questions in different places
Give a URL link to the Forum where you are making the same question:
Δώστε έναν σύνδεσμο URL για το φόρουμ όπου κάνετε την ίδια ερώτηση
Alan
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks