Sep 04 2019 07:31 AM
I am using excel VBA to automate table formatting. I have 24 tables to automate. I wrote the code with a macro then made some changes. It works fine (it autofills data on A3, E3, and F3, based on the last row in filled in column B. The problem is I need to modify the code for Tables 2 though 24. I could do this manually, but its a pain!! Is there a way to set A,B,E, an F as variables, and loop though this 23 more times by adding 18 letters each loop?
Greg
***CODE FOR TABLE 1
Range("A3").Select
Selection.autofill Destination:=Range("A3:A" & Range("B" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("E3").Select
Selection.autofill Destination:=Range("E3:E" & Range("B" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("F3").Select
Selection.autofill Destination:=Range("F3:F" & Range("B" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
***CODE FOR TABLE 2
Range("S3").Select
Selection.autofill Destination:=Range("S3:S" & Range("T" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("W3").Select
Selection.autofill Destination:=Range("W3:W" & Range("T" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Range("X3").Select
Selection.autofill Destination:=Range("X3:X" & Range("T" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
****and then 22 more times
Sep 04 2019 09:06 PM
Solution
This should do what you are trying to achieve....
Sub FormatTables()
Dim c As Long
Dim lr As Long
Dim i As Long
Application.ScreenUpdating = False
c = 1
For i = 1 To 24
lr = Cells(Rows.Count, c + 1).End(xlUp).Row
If lr > 2 Then
Cells(3, c).AutoFill Destination:=Range(Cells(3, c), Cells(lr, c))
Cells(3, c + 4).AutoFill Destination:=Range(Cells(3, c + 4), Cells(lr, c + 4))
Cells(3, c + 5).AutoFill Destination:=Range(Cells(3, c + 5), Cells(lr, c + 5))
End If
c = c + 18
Next i
Application.ScreenUpdating = True
End Sub
Sep 05 2019 10:53 AM
AMAZING!!! I spent, like, hours yesterday entering all of the cells names in manually...and this does it perfectly! Even better, there are other actions that I need to automate on the same data set as well. I'm hoping that I can just modify this sub and use it in other ways as well.
Thank you so much!!!!
Greg
Sep 05 2019 11:21 AM
You're welcome Greg! Glad it worked as desired.
Thanks for the feedback.
Please take a minute to accept my post with the proposed solution as an Answer and hit the like button. :)
Subodh
Sep 05 2019 01:23 PM
Haha! I used your sub as a template and this new sub goes back and merges those cells that you did the autofill on. Worked great!
Actually, instead of 2 subs, I could probably just merge the two subs together...
Greg
Sub mergecells()
Dim c As Long
Dim lr As Long
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
c = 1
For i = 1 To 26
lr = Cells(Rows.Count, c + 1).End(xlUp).Row
If lr > 2 Then
With Sheets("QC Chart 2 Prep")
.Range(.Cells(3, c), .Cells(lr, c)).Merge
.Range(.Cells(3, c + 4), .Cells(lr, c + 4)).Merge
.Range(.Cells(3, c + 5), .Cells(lr, c + 5)).Merge
End With
End If
c = c + 18
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sep 05 2019 02:28 PM - edited Sep 05 2019 02:32 PM
So, I combined those 2 subs together and it works great!
The last thing I need to do is to move the 26 charts I made I made into a single column. manualy, I do this:
------------------------------
Range("S3:X37").Select
Selection.Copy
Range("A38").Select
ActiveSheet.Paste
Range("AK3:AP37").Select
Selection.Copy
Range("A73").Select
ActiveSheet.Paste
etc....26 times...
------------------------------------
so, the selected range is S3:X37 (which is .cell(3,19) to .cell(37,24))
then copy
and paste into A38 (which is .cell(35,1))
The next chart is Range "AK3:AP37 (which is 18 columns to the right)
then copy
and paste into A73 (which is 38 rows down on column A).
however, when I run the sub (below) I get the a compile error (invalid or unqualified reference)! Hopefully its something simple that I'm doing wrong....do you see what that might be?
Thanks,
Greg
Sub movecharts()
Dim er As Long
Dim ec As Long
Dim sc As Long
Dim i As Long
Dim fr As Long
Application.ScreenUpdating = False
sc = 19
ec = 24
fr = 35
For i = 1 To 26
Range(.Cells(3, sc), .Cells(37, ec)).Select
Selection.Copy
Range(.Cells(fr, 1)).Select
ActiveSheet.Paste
sc = sc + 18
sr = sr + 18
fr = fr + 35
Next i
Application.ScreenUpdating = True
End Sub
Sep 05 2019 08:41 PM
The problem is with the following two lines...
1. Range(.Cells(3, sc), .Cells(37, ec)).Select
2. Range(.Cells(fr, 1)).Select
In the first line you are using . (period) before the Cells which is used when you specify the parent object in a WITH and END WITH block so it is not required here and you should remove the period from both the occurrences of Cells in that line. Also, you don't need to use Select in order to copy a range so you can replace Select with Copy.
In second line Range object expects a cell address not the cell object itself so use of Range in that line doesn't make any sense, you can use only Cells(fr, 1).Select and that will work as desired.
Please try it like this...
Sub movecharts()
Dim sr As Long
Dim er As Long
Dim ec As Long
Dim sc As Long
Dim i As Long
Dim fr As Long
Application.ScreenUpdating = False
sc = 19
ec = 24
fr = 35
For i = 1 To 26
Range(Cells(3, sc), Cells(37, ec)).Copy
Cells(fr, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = 0
sc = sc + 18
sr = sr + 18
fr = fr + 35
Next i
Application.ScreenUpdating = True
End Sub
Sep 06 2019 10:57 AM
Perfect fix! Thanks so much! Obviously, I'm not a programmer, just a chemist trying to automate reports that my team and I do over and over again. This will help so much!
There was a mistake in the code I fixed....(needed to fix the increment at the end (ec = ec + 18)). I also didn't need some of the variables I initially included ("sr" and "er", so I deleted them). Also, I ran this directly after another loop so I changed "i" to "j". I have the final code included below for completeness.
Dim ec As Long
Dim sc As Long
Dim j As Long
Dim fr As Long
Application.ScreenUpdating = False
sc = 19
ec = 24
fr = 35
For j = 1 To 26
Range(Cells(3, sc), Cells(37, ec)).Copy
Cells(fr, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = 0
sc = sc + 18
ec = ec + 18
fr = fr + 35
Next j
Application.ScreenUpdating = True
Sep 04 2019 09:06 PM
Solution
This should do what you are trying to achieve....
Sub FormatTables()
Dim c As Long
Dim lr As Long
Dim i As Long
Application.ScreenUpdating = False
c = 1
For i = 1 To 24
lr = Cells(Rows.Count, c + 1).End(xlUp).Row
If lr > 2 Then
Cells(3, c).AutoFill Destination:=Range(Cells(3, c), Cells(lr, c))
Cells(3, c + 4).AutoFill Destination:=Range(Cells(3, c + 4), Cells(lr, c + 4))
Cells(3, c + 5).AutoFill Destination:=Range(Cells(3, c + 5), Cells(lr, c + 5))
End If
c = c + 18
Next i
Application.ScreenUpdating = True
End Sub