1 Attachment(s)
Multiple concerns with my Sheets
Hi all.
Hopefully I can make this concise enough.
I am trying to split up one big data table into smaller tables for easier reading for management. The process to do this takes too long, which is why I am trying to code it. Once I'm done here, I will also build code to simplify sending this via email.
The process I am doing is hide the unnecessary, filter available data, provide a header for the table, then paste the smaller table into the new sheet. Rinse and repeat until all pieces of data are assembled in the new sheet.
Somehow, whenever I add the second header, It would either not copy, or it would copy over existing data. Also, the second table does not align right below my header.
I stopped developing my code at the second table because i should just be copy pasting the remaining code.
Code:
Sub Ecom_Aux_Dumptest()
' Ecom_Aux_Dump Macro
' Automatically copies all required data for Ecom Aux, instead of doing it manually.
'
' COPY FROM ONE SHEET TO ANOTHER
' Sheets("Sheet1").Range("A1:B10").Copy Destination:=Sheets("Sheet2").Range("E1")
' Codeflow: Set formatting>Copy>Paste>Repeat
' DO NOT ACTIVATE OR SELECT SHEETS IN CODE
' ADD VALUES INDIRECTLY
Dim aux As Worksheet
Dim dump As Worksheet
Dim LastAux As Long
Dim LastDump As Long
Set aux = Sheets("ECOM AUX")
Set dump = Sheets("Ecom Aux Macro Dump")
With Sheets("ECOM AUX")
LastAux = .Range("A:P").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
With Sheets("Ecom Aux Macro Dump")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastDump = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
End With
Application.ScreenUpdating = False
' Hide columns
aux.Columns("F:G").EntireColumn.Hidden = True
' Filter according to color
aux.Sort.SortFields.Add(aux.Columns("H:H"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 199, 206)
aux.Range("$A$1:$O$311").AutoFilter Field:=8, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor
If Range("H2").Value > 0 Then
' Adding Break text, with formatting
With dump.Range("A1")
.Value = "BREAK"
.Name = "Tahoma"
.Font.Size = 10
.Font.Bold = True
.Interior.Color = RGB(255, 255, 0)
End With
' Copying and pasting the data
aux.Range("A1:H" & LastAux).Copy
dump.Range("A2").PasteSpecial Paste:=xlPasteFormats
dump.Range("A2").PasteSpecial Paste:=xlPasteValues
End If
' Clear Filters and Hide Cell
aux.ShowAllData
aux.Columns("H:H").EntireColumn.Hidden = True
'>>>>>>>>>>>>>>>>>>>COLUMN I<<<<<<<<<<<<<<<<
' REPEAT Filter according to color
aux.Sort.SortFields.Add(aux.Columns("I:I"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 199, 206)
aux.Range("$A$1:$O$311").AutoFilter Field:=8, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor
If Range("I2").Value > 0 Then
' Adding Break text, with formatting
With dump.Range("A1" & LastDump).Offset(2, 0)
'>>>UPDATE TEXT
.Value = "COACHING"
.Name = "Tahoma"
.Font.Size = 10
.Font.Bold = True
.Interior.Color = RGB(255, 255, 0)
End With
' Copying and pasting the data
aux.Range("A1:I" & LastAux).Copy
dump.Range("A1" & LastDump).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
dump.Range("A1" & LastDump).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
' Clear Filters and Hide Cell
aux.ShowAllData
aux.Columns("I:I").EntireColumn.Hidden = True
' REPEAT Filter according to color
aux.Range("$A$1:$O$311").AutoFilter Field:=10, Criteria1:=RGB(255, _
199, 206), Operator:=xlFilterCellColor
Application.ScreenUpdating = True
End Sub
I think the way I have found the cell of the last row is not working. I have made multiple attempts to find it, as well as tried many methods, mostly from
https://stackoverflow.com/questions/...69920#11169920
If I didn't make sense, I have attached the table here.
Please help. I screwed my last forum post, hopefully I make it right here.
