Suggestions on how to fix this Macro code?

[deletedalien]

Hi all,

i've got a macro code that i recorded and patched to help with my day to day reporting but it still has a lot of manual work, because i have to run this macro over and over and over...

I also have another macro to run whenever there is a date change in the data (you will notice this because there is no campaign right above the date and there would be another date in there...

This isnt too much manual work but when i have to run a months worth of data it gets really tedious....

So here is my code.

(i know.. it isn't much but i'm not really VBA savvy... )

Sub Copy_campaign()
    Selection.copy
    Selection.End(xlToLeft).Offset(2, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.End(xlUp).Select
    Selection.copy
    Range(Selection, Selection.End(xlDown).Offset(-5)).Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlDown).Select
    Selection.End(xlDown).Offset(-1, 2).Select
    
  'Copy Date
    
     Selection.copy
    Selection.End(xlDown).Select
    ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate
    Range(Selection, Selection.End(xlUp).Offset(5)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        On Error Resume Next
        Application.CutCopyMode = False
    Selection.End(xlUp).Offset(0, 1).Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
  
       
End Sub

so in essence what i need is simple:

Add 2 columns before column "A"

move the campaign name 2 columns to the left and 2 cells down from its current location
Copy it down as many times as needed (see file)

move date 1 column to the left of the times column (times shown as 06:00 - 06:30 ) and format it as date
copy date down as many times as needed and move to the next range which could be a campaign change or date change and proceed as shown in file.
Finally stop the loop when the word "Page" is found. or just stop when there's more than 2 black cells below the data or something.

This should all make a whole lot more sense when you see my file:

https://www.dropbox.com/s/62nnokrh07j5nn4/Raw Data.xlsx?dl=0


i would highly appreciate ANY help provided with this as you would be saving me AGES worth of time (especially on month end reporting dates)

 

[Michael M]

I have made some assumptions...
The Campaign names in Col "A" ARE left aligned !
AND
the dates in Col "A" are BOLD and actual dates

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = 3 To lr
    If Range("A" & r).Font.Bold = False And Range("A" & r).Value <> "" Then Range("F" & r).Value = Range("A" & r).Value
    If Range("A" & r).HorizontalAlignment = xlLeft And Range("A" & r).Font.Bold = True Then
        Range("D" & r).Offset(2).Value = Range("A" & r).Value
    End If
    If IsDate(Range("A" & r)) = True Then Range("E" & r).Offset(1).Value = Range("A" & r).Value
    If Range("F" & r).Value <> "" And Range("E" & r - 1).Value <> "" Then Range("E" & r).Value = Range("E" & r - 1).Value
    If Range("D" & r + 1).Value = "" Then Range("D" & r + 1).Value = Range("D" & r).Value
    If Range("F" & r).Value = "" And Range("E" & r).Value = "" Then Range("D" & r).Value = ""
Next r
End Sub

 

[deletedalien]

Im sorry but this code is not what im looking for, it doesn't insert 2 columns before Col "A" at the beginning of the code... and its actually formatting other cells.

I do appreciate you taking the time to give it a try tho

 

[Michael M]

Well, I can insert the extra columns and mod the code if you wish

 

[Michael M]

Is this closer ??

Sub MM1()
Dim lr As Long, r As Long
Columns("A:B").Insert
lr = Cells(Rows.Count, "C").End(xlUp).Row
For r = 3 To lr
    If Range("C" & r).Font.Bold = False And Range("C" & r).Value <> "" Then Range("H" & r).Value = Range("C" & r).Value
    If Range("C" & r).HorizontalAlignment = xlLeft And Range("C" & r).Font.Bold = True Then
        Range("F" & r).Offset(2).Value = Range("C" & r).Value
    End If
    If IsDate(Range("C" & r)) = True Then Range("G" & r).Offset(1).Value = Range("C" & r).Value
    If Range("H" & r).Value <> "" And Range("G" & r - 1).Value <> "" Then Range("G" & r).Value = Range("G" & r - 1).Value
    If Range("F" & r + 1).Value = "" Then Range("F" & r + 1).Value = Range("F" & r).Value
    If Range("H" & r).Value = "" And Range("G" & r).Value = "" Then Range("F" & r).Value = ""
Next r
End Sub

 

[deletedalien]

Is this closer ??

Sub MM1()
Dim lr As Long, r As Long
Columns("A:B").Insert
lr = Cells(Rows.Count, "C").End(xlUp).Row
For r = 3 To lr
    If Range("C" & r).Font.Bold = False And Range("C" & r).Value <> "" Then Range("H" & r).Value = Range("C" & r).Value
    If Range("C" & r).HorizontalAlignment = xlLeft And Range("C" & r).Font.Bold = True Then
        Range("F" & r).Offset(2).Value = Range("C" & r).Value
    End If
    If IsDate(Range("C" & r)) = True Then Range("G" & r).Offset(1).Value = Range("C" & r).Value
    If Range("H" & r).Value <> "" And Range("G" & r - 1).Value <> "" Then Range("G" & r).Value = Range("G" & r - 1).Value
    If Range("F" & r + 1).Value = "" Then Range("F" & r + 1).Value = Range("F" & r).Value
    If Range("H" & r).Value = "" And Range("G" & r).Value = "" Then Range("F" & r).Value = ""
Next r
End Sub

Yup, its closer in the sense that it has added the 2 columns before "A" but its still just formatting columns "G" and "H"

I don't mean to be a smart a55 and i really do HIGHLY appreciate your help but... did you see the file in the link? it shows what i have and what its supposed to be like.

https://www.dropbox.com/s/62nnokrh07...Data.xlsx?dl=0

 

[deletedalien]

bump

 

[Michael M]

Note the comment on the 2nd last line

Sub MM1()
Dim lr As Long, r As Long
Columns("A:B").Insert
lr = Cells(Rows.Count, "C").End(xlUp).Row
For r = 3 To lr
    If Range("C" & r).Font.Bold = False And Range("C" & r).Value <> "" Then Range("H" & r).Value = Range("C" & r).Value
    If IsDate(Range("C" & r)) = False And Range("C" & r).Font.Bold = True Then
        Range("F" & r).Offset(2).Value = Range("C" & r).Value
    End If
    If IsDate(Range("C" & r)) = True Then Range("G" & r).Offset(1).Value = Range("C" & r).Value
    If Range("H" & r).Value <> "" And Range("G" & r - 1).Value <> "" Then Range("G" & r).Value = Range("G" & r - 1).Value
    If Range("F" & r + 1).Value = "" Then Range("F" & r + 1).Value = Range("F" & r).Value
    If Range("H" & r).Value = "" And Range("G" & r).Value = "" Then Range("F" & r).Value = ""
Next r
    With Range("C2:C" & lr).Interior
.Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Range("F2:H" & lr).Interior
.Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399945066682943
        .PatternTintAndShade = 0
    End With
    Columns("G:G").NumberFormat = "dd/mm/yyyy" 'this may need to be modified to suit your regional settings
End Sub

 

[deletedalien]

NOW we talkin!

Thanx man i appreciate the effort

IT WORX!!! yessssssssss!!!!!!!!!!!

 

[Michael M]

glad we resolved it...