Copy first non-blank column to the left using macro

[elizabethlll]

Hello, I'm new to posting though reference threads from time to time - thank you!

I'm trying to create a macro that selects a range of cells in the current column, and then copies information from the cells in the column directly to the left in the range. I have gotten that to work successfully this far with the following (there are 51 cells I'm interested in):

Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(51, 0)).Select
Selection.FillRight

This would happen daily, each day is a new column that copies the previous column when the user clicks a button that I've assigned the macro to. My problem is that after every 5 days, there are two blank columns (these represent Sat and Sun, for which no data is entered). So the user would come in Monday, run the macro to populate from the previous "day" (previous column) and it would come back with blanks. Is there a way to write a macro that populates fro the previous "day" (column) unless that column is blank, in which case it would populate from last "day" (column) with values? I should say that it's OK if there are some blank CELLS in the column from which I'm populating, but the whole column can't be blank.

Thank you!

 

[JPARKHURST]

whoops, i made a couple of mistakes in there, sorry, was playing around for a different function, must have copied that in middle. Give me another second.

 

[JPARKHURST]

Here, try this. Paste itno module, call with

call UpdateToday

and the code is:

Sub UpdateToday()
 Dim rSource As Range, rDest As Range
 Dim lOffset As Long
 
 lOffset = -1
 Set rDest = Range(ActiveCell, ActiveCell.Offset(16, 0))
 Set rSource = rDest.Offset(0, lOffset)
    
    Do While Not FindWeekday(rSource)
        lOffset = lOffset - 1
        Set rSource = rSource.Offset(0, lOffset)
        MsgBox ("DoWhile::: rSource: " & rSource.Address)
    Loop
 
 rDest.Value = rSource.Value
 
 Set rSource = Nothing
 Set rDest = Nothing
End Sub


Public Function FindWeekday(rCheck As Range) As Boolean
    If Application.WorksheetFunction.CountA(rCheck) > 0 Then
      FindWeekday = True
      'MsgBox ("Found Weekday")
      Else
        'MsgBox ("Found Weekend")
        FindWeekday = False
    End If
End Function

HTH,

Jon

 

[elizabethlll]

Thanks Jon! Unfortunately, I'm still coming up blank for Monday's in my sheet. Unfortunately, this is far beyond my skills to trouble-shoot!

 

[JPARKHURST]

Here is my sample data. Does this look like your table? I click on Monday, it pushes Friday's data in (it actually gives a message i forgot to comment out first). Let's make sure the structure is what i think it is first, then we'll look.

Fri 06/15
Sat 06/16
Sun 06/17
Mon 06/18
Tue 06/19
Wed 06/20
Thu 06/21
Fri 06/22
Sat 06/23
Sun 06/24
Mon 06/25
Tue 06/26
Wed 06/27
Thu 06/28
Fri 06/29
data1
159
874
86984
1033
87858
88017
86984
159
 
 
 
 
 
 
 
data2
357
566
4654
923
5220
5577
4654
357
 
 
 
 
 
 
 
data3
645
448
33
1093
481
1126
33
645
 
 
 
 
 
 
 
data4
132
741
16541
873
17282
17414
16541
132
 
 
 
 
 
 
 
data5
325
157
516
482
673
998
516
325
 
 
 
 
 
 
 
data6
336
556
654
892
1210
1546
654
336
 
 
 
 
 
 
 
data7
5489
9844
654
15333
10498
15987
654
5489
 
 
 
 
 
 
 
data8
47984
65498
3
113482
65501
113485
3
47984
 
 
 
 
 
 
 
data9
3546
6579
456
10125
7035
10581
456
3546
 
 
 
 
 
 
 
data10
354
564779
465436
565133
1030215
1030569
465436
354
 
 
 
 
 
 
 
data11
654886
651
0
655537
651
655537
0
654886
 
 
 
 
 
 
 
data12
564
56413
4655
56977
61068
61632
4655
564
 
 
 
 
 
 
 
data13
3366
36213
6546489
39579
6582702
6586068
6546489
3366
 
 
 
 
 
 
 
data14
444
6546
5646
6990
12192
12636
5646
444
 
 
 
 
 
 
 
data15
85856
16056
774
101912
16830
102686
774
85856
 
 
 
 
 
 
 
data16
5698
654065
1147
659763
655212
660910
1147
5698
 
 
 
 
 
 
 
data17
887
8746
5583
9633
14329
15216
5583
887
 
 
 
 
 
 
 

<colgroup><col><col><col><col span="2"><col span="2"><col span="2"><col><col><col><col><col><col><col></colgroup><tbody>

</tbody>

 

[JPARKHURST]

And - just in case - try re-copying the text below. If you dont' get an error, you should get a pop-up message which contains the Source Range Address.

Sub UpdateToday()
 Dim rSource As Range, rDest As Range
 Dim lOffset As Long
 
 lOffset = -1
 Set rDest = Range(ActiveCell, ActiveCell.Offset(16, 0))
 Set rSource = rDest.Offset(0, lOffset)
    
    Do While Not FindWeekday(rSource)
        lOffset = lOffset - 1
        Set rSource = rSource.Offset(0, lOffset)
        MsgBox ("DoWhile::: rSource: " & rSource.Address)
    Loop
 
 rDest.Value = rSource.Value
 
 Set rSource = Nothing
 Set rDest = Nothing
End Sub


Public Function FindWeekday(rCheck As Range) As Boolean
    If Application.WorksheetFunction.CountA(rCheck) > 0 Then
      FindWeekday = True
      'MsgBox ("Found Weekday")
      Else
        'MsgBox ("Found Weekend")
        FindWeekday = False
    End If
End Function

 

[elizabethlll]

Your sample data looks good, except I don't have the day in the format. So for instance, I just have 6/26/2018 NOT Tue 06/26. I use a different date table to assign what day of the week, fiscal year, etc.

 

[JPARKHURST]

Did you get this to work, and if not, what is the msg box saying when it comes up?

(remember, if something errs, you have to reset the project before code will run again)

You may try copying that last code bit, just to be sure. Also, uncomment some of the message boxes to see what is going off. Mine is still working each time i have tried.

Thanks,

Jon