Modifiy VBA code to paste to Next available Colunm

**KjBox** · Jun 15th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Quote

However, I have found that some data that are in white cells are also required.

Which white cells?

Moe Kadhom · Jun 15th 2015

Re: Modifiy VBA code to paste to Next available Colunm

hi KJ
All white cells that have data.

Thanks

**KjBox** · Jun 15th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Try the attached file.

Before running the code you will need to open every Branch file and make 2 changes to the Warehouse Sheet:

Cell A35: change Gross Profit to Gross_Profit

Cell A64 change Overheads to Overheads_

Moe Kadhom · Jun 15th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
Fantastic.

I made the change to one file and all the data that I want pasted correctly.

Ill make the change to all the files and it should give me the same result.

Thanks a lot for taking the time to help me. You have been great as usual.

Moe Kadhom · Jul 1st 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
I have been running the macro for a while now and it is working perfectly.

However, I am having trouble ensuring that the yellow cells remain the same colour at all times. Many people have access to these files and sometime they change the yellow colour to something else and this causes the macro to fail.

If this is not too much to ask, Is there any way you can modify the macro so it picks up the content of the yellow cells even if they are different colours?

Let me know your thoughts.

Thanks

**KjBox** · Jul 4th 2015

Re: Modifiy VBA code to paste to Next available Colunm

To try and modify the code to get just the required cells gets very complicated because the required cells are different for every sheet.

The only work around I can think of is going to be a mind-numbing exercise for you!

If you go to every town file and with the sheets: "Retail", "Fleet", "Warehouse Solutions", "Rentals", "Service" then, in Column B only, set a conditional format for all the yellow cells and all cells with no fill, but which do have a value, and set a conditional format for each of those cells with the following formula:

=Len(B12)>=0

Change the cell reference (B12) to suit each cell, in the case of cells that have no fill, but a value, make sure you click the 'No Color' button when setting the format DO NOT make the colour white!

When all that is done is a user tries to change the colour of any of the cells required by the code then the colour change will not be allowed and the colour will immediately revert to what it should be.

Hope that helps.

Moe Kadhom · Jul 5th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
Thanks for heading me into the right direction.

below code was mostly done using the macro recorded, and it basically sets the conditional formatting for all the required cells to their appropriate colour.

Could you modify the code so it:
-Choose a folder
-Select files
-For each file, run the code below
-Save each file
-Exit

I could just open every file and run the macro but I thought by adding above, you can save me a lot of work.

Thanks

Code

Sub ConditionalFormatting()
'
' Setting Conditional Formatting to Branch forecasts files
'
'
 For Each ws In Sheets
   With ws
   .Unprotect Password:="kirsty"
    .EnableOutlining = True
   End With
 Next ws
 Sheets("Retail").Select
    Range("B7,B9,B15,B17,B19,B26:B33").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B7)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11,B21,B22,B34,B38:B42").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B11)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11").Select
    Sheets("Fleet").Select
    Range("B7,B9,B15,B17,B19,B26:B33").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B7)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11,B21,B22,B34,B38:B42").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B11)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11").Select
    Sheets("Warehouse Solutions").Select
    Range("B10,B12,B18,B20,B26,B28,B39,B41,B46,B48,B53,B55").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B10)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B14,B22,B30,B32,B43,B50,B57,B60,B61,B71,B72,B73,B75").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B14)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A35").Select
    ActiveCell.FormulaR1C1 = "Gross Profit."
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=13, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -6563900
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A64").Select
    ActiveCell.FormulaR1C1 = "Overheads."
    With ActiveCell.Characters(Start:=1, Length:=9).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With ActiveCell.Characters(Start:=10, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -6563900
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Sheets("Service").Select
    Range("B9:B12,B16,B19,B23:B26,B30,B33,B37,B39,B40,B42,B46,B48,B52,B59,B63,B65:B66,B68,B69,B71,B72,B74,B75,B77,B86:B96,B97").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B9)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B7,B14,B15,B17,B18,B28,B29,B31,B32,B38,B41,B50,B51,B64,B67,B70,B73,B76,B81,B82,B83,B98,B102:B106").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B7)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11").Select
    Sheets("Rentals").Select
    Range("B9,B10,B11,B12,B13,B18,B19,B20,B21,B22,B29,B30,B31,B32,B33,B34,B35,B36,B43,B44,B45,B46").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B9)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B7,B14,B24,B25,B39,B47,B51:B55").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=LEN(B7)>=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B11").Select
     For Each ws In Sheets
   With ws
   .Protect Password:="kirsty"
    .EnableOutlining = True
   End With
 Next ws
End Sub

Display More

**KjBox** · Jul 5th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Try this

Code

Sub ConditionalFormatting()
    ' Setting Conditional Formatting to Branch forecasts files
    
    Dim wbIn As Workbook, ws as Worksheet,  diaFolder As FileDialog, lCount As Long
    
    Set diaFolder = Application.FileDialog(msoFileDialogFilePicker)
    With diaFolder
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewList
        .InitialFileName = sInitialPath
        lCount = .Show
    End With
    If lCount <> -1 Then
        MsgBox "No file selected", , "File Picker"
        Exit Sub
    Else
        For lCount = 1 To diaFolder.SelectedItems.Count '// Loop through selected Branch workbooks
            Application.DisplayAlerts = False
            Set wbIn = Workbooks.Open(diaFolder.SelectedItems(lCount))
            Application.DisplayAlerts = True
            With wbIn
                For Each ws In .Sheets
                    '// REST OF YOUR CODE HERE
                Next ws
                .Close True
            End With
        Next
    End If
End Sub

Display More

Moe Kadhom · Jul 5th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Great. worked perfectly.

Thanks for your help

**KjBox** · Jul 5th 2015

Re: Modifiy VBA code to paste to Next available Colunm

You're welcome

Moe Kadhom · Jul 15th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Hi KJ
There are two more cells highlighted in yellow that I would like the macro copy to the master workbook.

Cell B5 in " service " and Cell B5 in " Rentals" tab. Both are highlighted the same yellow as the other yellow cells.

How do I modify the macro so it picks up these two cells too?

Thanks

**KjBox** · Jul 29th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Sorry, I somehow missed you new post. Try this.

Moe Kadhom · Jul 30th 2015

Re: Modifiy VBA code to paste to Next available Colunm

Perfect as always. Thanks

**KjBox** · Jul 30th 2015

Re: Modifiy VBA code to paste to Next available Colunm

You're welcome

Modifiy VBA code to paste to Next available Colunm

Participate now!

Share

Users Viewing This Thread