Help with VBA Loop & Finding Last Column in a Number of Rows

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
141
Office Version
  1. 2013
Platform
  1. Windows
Hi. I need help with VBA. I'll try to explain clearly what I require and hopefully won't sound too confusing.
I have included a picture to help explain. I have a log. Each day I populate the sheet for the present day's column. The number of columns to the right goes on forever, like as much as Excel will allow. At the end of each day the current day's column will be fully populated.. The data entry rows on each column are row 2 to 22, there is no data to the right of the current day in rows 2 to 22. On rows 24 and 26 there are formula. Each day when rows 2 to 22 are fully populated I copy and paste the values over the formula. The formula remain hidden to the right until at least one cell is populated in the rows 2 to 22. I would like to automate this copy and pasting I have to do every day when the column is complete. I don't require a Worksheet_change trigger, a command button will suffice (in case I have made a mistake). So the criteria would be as follows:
I need to be able to detect the last column in rows 2 to 22. I beleive this code is for for checking say row 2
VBA Code:
Dim lc As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Buddy Log")

lc = ws.Cells(2, Columns.Count).End(xlToLeft).Column

I would then need a loop to check rows 3 onwards to 22. The starting column can basically be any column after "J" as everything before has formula or text. This is when things get tricky. I would either need a statement to test whether all 21 rows have the same last column index to then fire the copy and paste values of the corresponding column index into rows 24 and 26. OR, when the loop detects the last column with data (would not matter which one) to then count the number of non empty cells. If the number of non empty cells = 0 then to perform the copy and paste scenario as mentioned.

I hope that is clear. Thanks
 

Attachments

  • CaptureResize.JPG
    CaptureResize.JPG
    233.8 KB · Views: 29

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I should maybe have said, that in the picture I am currently on column KN. so, when KN2 to KN22 have data added I will then copy and past values over the KN24 and again on KN26. KO24 and KO26 and everything to the right remain with formula until the next day and so on.
 
Upvote 0
Can you change it to fit your need. If not, let us know.
Code:
Sub Maybe()
Dim lc As Long
lc = Rows("2:22").Find("*", , , , 2, 2).Column    '<---- Change Row numbers as required
If WorksheetFunction.CountA(Range(Cells(2, lc), Cells(22, lc))) < 21 Then MsgBox "Not all filled"
End Sub
 
Upvote 0
Solution
Thanks,
Can you change it to fit your need. If not, let us know.
Code:
Sub Maybe()
Dim lc As Long
lc = Rows("2:22").Find("*", , , , 2, 2).Column    '<---- Change Row numbers as required
If WorksheetFunction.CountA(Range(Cells(2, lc), Cells(22, lc))) < 21 Then MsgBox "Not all filled"
End Sub
Yes that will work. I basically had it the following just checking row 2 and then pasting into Row 24
VBA Code:
Sub Test()

Dim lc As Long, rng As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Buddy Log")
Set rng = ws.Range("A2:AAA22")


lc = ws.Cells(2, Columns.Count).End(xlToLeft).Column

rng.Cells(1, lc).Offset(22, 0).Select
 Selection.Copy
 
 ActiveCell.PasteSpecial (xlPasteValues)

End Sub

Can you explain what the Find("*", , , , 2, 2).Column means?

Thanks for the reply
 
Upvote 0
Can you change it to fit your need. If not, let us know.
Code:
Sub Maybe()
Dim lc As Long
lc = Rows("2:22").Find("*", , , , 2, 2).Column    '<---- Change Row numbers as required
If WorksheetFunction.CountA(Range(Cells(2, lc), Cells(22, lc))) < 21 Then MsgBox "Not all filled"
End Sub
Thanks. Very elegant and I adjusted it slightly. I would never have thought of doing what you've done. Very much appreciated.

VBA Code:
Sub ThankYou()

Dim lc As Long

lc = Rows("2:22").Find("*", , , , 2, 2).Column    '<---- Change Row numbers as required
  If WorksheetFunction.CountA(Range(Cells(2, lc), Cells(22, lc))) < 21 Then
     MsgBox "Not all filled"
  Else
Cells(24, lc).Resize(3).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
Cells(2, lc).Offset(0, 1).Select
  End If
End Sub
 
Upvote 0
I would change this
Code:
Cells(24, lc).Resize(3).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
to this
Code:
Cells(24, lc).Resize(3).Value = Cells(24, lc).Resize(3).Value
 
Upvote 0
I would change this
Code:
Cells(24, lc).Resize(3).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
to this
Code:
Cells(24, lc).Resize(3).Value = Cells(24, lc).Resize(3).Value
Thanks
 
Upvote 0

Forum statistics

Threads
1,214,819
Messages
6,121,746
Members
449,050
Latest member
excelknuckles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top