Link to home
Start Free TrialLog in
Avatar of Theva
ThevaFlag for Malaysia

asked on

Macro for data consolidation

Hi Expers,

Consolidate data from sheet1 and sheet4 in “consolidation” sheet. I have manually transferred sample data for experts to get a better idea how the data need to be aligned. Any changes in sheet4 need to highlight if its different from sheet1. Hope Experts can help me to create this. Here’s the xls file for Experts perusal.
DataTest2.xls
Avatar of Shahid Thaika
Shahid Thaika
Flag of India image

I am guessing you formed the code off macro recording, that's exactly how I start many project :-). Anyway, first optimize your current code (Consol() subroutine) as below. Then you need a Primary Key like field to compare both the worksheets, else you cannot link them. You can use VLookUp formula to pull info from another worksheet into the current.

When it comes to comparison and highlighting of changes, I noticed your data is not perfect. The second worksheet has some prefixes in certain rows and none in the others. Also, the text there seems to be cut off due to some reason. Hence in this case you can use the InStr() to see if a particular text exists within the other. You would do something like this...

If InStr(1, Sheet1_Data1, Sheet2_Data1, vbTextCompare) > 0 OR InStr(1, Sheet2_Data1, Sheet1_Data1, vbTextCompare) > 0 Then
.
.
.
End If


Alternatively, I would automate Conditional formatting on the different columns, once all the data has been pulled into the same worksheet. You can do a macro record for the code ;-)

Hope this helps...
Sub Consol()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Range(Sheets("sheet4").Range("A2"), Sheets("sheet4").Range("A2").SpecialCells(xlCellTypeLastCell)).ClearContents
    Range(Sheets("sheet2").Range("A1"), Sheets("sheet2").Range("A1").End(xlDown)).Copy
    Sheets("Sheet4").Activate
    Sheets("Sheet4").Range("A2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    Range(Sheets("sheet4").Range("A2"), Sheets("sheet4").Range("A1").End(xlDown)).TextToColumns Destination:=Sheets("Sheet4").Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
    
    Sheets("Sheet4").Columns("G:Z").ClearContents
    Sheets("Sheet4").Cells.EntireColumn.AutoFit

    Sheets("Sheet4").Range("G2").Formula = "=IF(IF(MID(A2,12,2)+8>23,MID(A2,12,2)+8-24,MID(A2,12,2)+8)<10,""0"" & IF(MID(A2,12,2)+8>23,MID(A2,12,2)+8-24,MID(A2,12,2)+8),IF(MID(A2,12,2)+8>23,MID(A2,12,2)+8-24,MID(A2,12,2)+8))& RIGHT(A2,9)"
    Range(Sheets("Sheet4").Range("G2"), Sheets("Sheet4").Range("F1").End(xlDown).Offset(0, 1)).FillDown
    Range(Sheets("Sheet4").Range("G2"), Sheets("Sheet4").Range("F1").End(xlDown).Offset(0, 1)).Copy
    Sheets("Sheet4").Range("A2").PasteSpecial xlPasteValues
    Range(Sheets("Sheet4").Range("G2"), Sheets("Sheet4").Range("F1").End(xlDown).Offset(0, 1)).ClearContents
    
    Sheets("Sheet4").Range("A1").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

Open in new window

Avatar of Theva

ASKER

Hi eeshahidt,

The credit should go to Experts, the macro was created by Experts. Thanks for refining it.

 Now I need experts help to consolidate these 2 data (sheet 1 & 4) in "consolidation" sheet. Please ignore column-E when comparing the data, its there for record purpose.

The sample were manually extracted to give a better view on the end result. Hope you could help to build this.
Hi Theva. Before I can help, I need a few things.

1. Please format Sheet1 in a nice way similar to Sheet4
2. Include an ID column in both sheets. This is very important and no one can proceed without this. We need this to know which row from Sheet1 should be compared to a row in Sheet4. Bottom line, both sheets should have a column that is column to both and will always be correct.
Avatar of Theva

ASKER

Hi,

Sheet1 is actually original document that we need to crosscheck. Preferably not to distract the actual format. This is to get client confident that we never touch or modified their document. I have rename my "consolidation" sheet's header in order to give a better understanding which columns that we need to compare with.

In "Consolidation" sheet, we need to compare Column-B with A, Column-D with C and the cue tone need to be compared with Column-F with G.

I have attached the sample code, I hope Experts could help me to revised this script so that we can have data comparison side by side. I hope the attached script and the revised wb helps.


Sub ReconcileData()
Dim Client As Worksheet
Dim Actual As Worksheet
Dim Reconcile As Worksheet
Dim arrActual() As String
Dim rw As Long
Dim datum As Long
Dim strErrors As String
    
    Set Client = ThisWorkbook.Worksheets("sheet1")
    Set Actual = ThisWorkbook.Worksheets("sheet2")
    Set Reconcile = ThisWorkbook.Worksheets("Consolidation")
    
    strErrors = ""
    Reconcile.Cells.Delete
    Client.Cells.Copy Reconcile.Cells
    Reconcile.Cells.Interior.ColorIndex = -4142
    Reconcile.Range("L3") = "Astro Program ID"
    For rw = 1 To Reconcile.Range("C" & Reconcile.Rows.Count).End(xlUp).Row
        If InStr(Reconcile.Range("C" & rw), ":") <> InStrRev(Reconcile.Range("C" & rw), ":") Then
            ' At least two semi colons in the cell
            datum = datum + 1   ' Line in system playlist
            arrActual = Split(Actual.Range("a" & datum), "|")
'            If InStr(LCase(arrActual(2)), LCase(Client.Range("H" & rw))) > 0 Then
'                Debug.Print "title matches in row " & rw
'            Else
'                Debug.Print "title MISMATCH in row " & rw
'            End If
            Actual.Range("n" & datum) = "actual Datum: " & datum & vbTab & "REconcile: " & rw
            Reconcile.Range("n" & rw) = "actual Datum: " & datum & vbTab & "REconcile: " & rw
            If Left(arrActual(5), InStrRev(arrActual(5), ":")) = Left(Client.Range("E" & rw), InStrRev(Client.Range("E" & rw), ":")) Then
'                Debug.Print "Time matches in row " & rw
                Reconcile.Range("D" & rw).Resize(1, 7).Interior.ColorIndex = -4142
                Reconcile.Range("L" & rw) = arrActual(1)
            Else
                Debug.Print "Time MISMATCH in row " & rw
                strErrors = strErrors & vbCrLf & "Time MISMATCH in row " & rw
                Reconcile.Range("D" & rw).Resize(1, 7).Interior.ColorIndex = 44
            End If
            Select Case Reconcile.Range("i" & rw)
                Case "Cue tone 9"
                    If Reconcile.Range("L" & rw) <> "AKSSW09HS11A" Then
                        Reconcile.Range("J" & rw).Resize(1, 3).Interior.ColorIndex = 44
                        Debug.Print "Cue Tone MISMATCH in row " & rw
                        strErrors = strErrors & vbCrLf & "Cue Tone MISMATCH in row " & rw
                    End If
                Case "Cue Tones 10"
                    If Reconcile.Range("L" & rw) <> "AKSSW10HS11A" Then
                        Reconcile.Range("J" & rw).Resize(1, 3).Interior.ColorIndex = 44
                        Debug.Print "Cue Tone MISMATCH in row " & rw
                        strErrors = strErrors & vbCrLf & "Cue Tone MISMATCH in row " & rw
                    End If
                Case "Cue Tones 11"
                    If Reconcile.Range("L" & rw) <> "AKSSW11HS11A" Then
                        Reconcile.Range("J" & rw).Resize(1, 3).Interior.ColorIndex = 44
                        Debug.Print "Cue Tone MISMATCH in row " & rw
                        strErrors = strErrors & vbCrLf & "Cue Tone MISMATCH in row " & rw
                    End If
                Case "Cue Tones 12"
                    If Reconcile.Range("L" & rw) <> "AKSSW12HS11A" Then
                        Reconcile.Range("J" & rw).Resize(1, 3).Interior.ColorIndex = 44
                        Debug.Print "Cue Tone MISMATCH in row " & rw
                        strErrors = strErrors & vbCrLf & "Cue Tone MISMATCH in row " & rw
                    End If
                Case Else
            End Select
        End If
    Next
    If strErrors = "" Then
        strErrors = "No Errors reported"
    Else
        strErrors = "Errors reported as follows:" & vbCrLf & strErrors
    End If
    MsgBox strErrors
    
    
End Sub

Open in new window

DataTest2.xls
Avatar of csmart2301
csmart2301


This is just an observation from the two Excel sheets that I’ve seen in your post but you should really start a database almost all of the work that you seem to be doing is database work only in spread sheets. Do you have MSAccess. If so that would be the way to go you would have way better control of your data.
 
Anyways, until we can convince you to start a database i will attempt to understand what you are doing here.
 
Clint

p.s. there are many video tutorials on Access Databases plus we Experts would be here to help.

Ok t'is done.

The code is a little big but it should do everything that you asked and I took my time this time and wrote it a little cleaner.

run macro Cons

It will build a new page called Consolida because i was leaving your page as a reference. I also changed a few of the customer’s values to check that the code was working but i noted what they were originally.

Good Luck
Clint

ClintsDataTest2-1-.xls
Avatar of Theva

ASKER

Hi,

Shows error, when debug highlight at this line:

  .ThemeColor = xlThemeColorDark1
csmart2301, I am afraid your code does not work. In addition, all those lines can be easily cut in half with more VBA programming experience. You have simply copy-pasted the two sheets without relating them properly. If you notice the Astro columns go beyond the last column of the sheet1 data columns. Like you said, a database would be the right thing for this application, but it could also be that this info was exported from a DB.

Hence, Theva, I need to know what is the primary key or which combination of columns would always be unique, to better help you. I thought of using Media No., but noticed that even this number gets duplicated at certain rows.
In response to...

Author Comment  
Hi,
Shows error, when debug highlight at this line:
  .ThemeColor = xlThemeColorDark1



What version of Excel do you have? It is possibly an Excel 2007 thing. You can safely delete that line, it's just formatting.

 
eeshahidt:
 
csmart2301, I am afraid your code does not work
 
I’ve tested it on two computers it works fine maybe I missed one of the criteria but from what I understood it does everything that was asked.
 
He did not provide a key  so I am assuming that’s because he does not want to make any changes to the file provided be his customers.  Also the data that he provided is only a sample cutting of his full set you can tell this by the fact that sheet 1 only goes to 9 o’clock and sheet4 goes to 10 o’clock that is why my data does not match at the end.
 
with more VBA programming experience.  
 
High and mighty aren't we! Don’t presume that you have more experience then someone based on how they write code I’ve been doing it long enough to not be impressed with one practice over another. I code in my way because for me it's quick making code that I only have to change a few things to duplicate the same effects. I could have created an object or two, used a “with” or two and combined the selection items in a loop of one- fifth the size but it would have not produced better results.
 
So if you want to post negative comments about me then pick a subject that you cam gather information about such as my inability to spell or my choice of variable names or something else that you might possibly be able to prove.
 
Good Day!
 
Clint
Avatar of Theva

ASKER

Hi,

Am using 2003 version. You're right, the original list exported from Oracle DB (scheduling system). My objective to have this tool is to make sure all program that were listed in sheet1 transmitted accordingly (100%).

There isn't any unique ID for this except for Cue Tone. This is because both sheets are extracted from different system. The most important is time and duration  are matched for both lists. For cue tone, IDs playing major roll in identifying whether the cue tone were scheduled well.

   
Theva:

Shows error, when debug highlight at this line:

  .ThemeColor = xlThemeColorDark1

 
remove the line it is not needed
also delete the Consolida sheet if it is already there
 
Avatar of Theva

ASKER

Hi eeshahidt,

I am appreciate your advice but undermine Clint's expertise is not unacceptable. I personally invite him after noticing your 2nd commend >

"2. Include an ID column in both sheets. This is very important and no one can proceed without this" which is not true and Clint has prove it.

appreciate if we can learn together and share our experiences with others.          

Avatar of Theva

ASKER

Hi Clint,

When I click command bottom in sheet-2, pop-up box appeared with message "ambiguous name detected: Consol" how to rectify this?  

I’ve been meaning to ask what is sheet 2 for? And the button runs the old consolidation code? Do you want it to run the new code?
 
If so right click the button and select assign macro then set it to cons.
 
If it was for something else then you will have to explain a little.
csmart2301, I don't intend to offend you in any way nor do I want to reply to your message, so sorry if I didn't come across well. In the interest of answering the authors question, kindly look at Row #147 after your code is executed. Some columns don't have data, others do. In addition those rows that do have all the data, they may not necessarily align up correct in the way it would have been, if done manually.

Theva, is it possible to include a Primary Key column? I was thinking of using VLookUp to properly consolidate the two sheets before making comparison. The comparison part is very easy, but we need the right data first.
Avatar of Theva

ASKER

Hi,

Sheet-2 having row data which extracted from server. I use macro at this page to align properly in sheet3. So that we can have a better data view. No need to re-write just wondering how to remove this error message?
ok give me a sec and i'll fix it
 
Just remove Module1 or Module2
It looks like they are copies of each other
I would remove number 1 number 2 is the cleaned copy
Open the vba window and right click on module1 and click remove save if you want but not nessary.
Avatar of Theva

ASKER

Hi eeshahidt,

I've created a sample data in "consolidation" sheet, these are my primary columns that we need to crosscheck excluding column-E. This column for client prof reading, furthermore the data in this line not coherent with sheet4. We only can lookup for cue tone, we have primary key for this. I've listed this in "consolidation" sheet. I do understand by having primary key we can make the data more organized, unfortunately both list were created by using different system and to get the right data for us to crosscheck become a tricky task. Hope you understand with current limitation.      

Thank you for not trying to offend me, sometimes i can get a little huffy so sorry about accusing you of trying to be unkind.
 
Anyway,
 
“kindly look at Row #147 after your code is executed. Some columns don't have data, others do”
 
I covered that His DATA is only snippets of the whole collection and he did not cut two chunks of the same size.
 
As for if his data not always lining up that will be obvious at that point because everything will be highlighted.
Avatar of Theva

ASKER

Hi,

Sorry to not sharing the whole data, I love to do this, but last week someone has posted my document that I'd shared in EE outside. That's put myself in big trouble. Even now am still waiting Moderator to remove this files. Here's the link:

https://www.experts-exchange.com/questions/25149808/Add-in-additional-information-in-Data-Consolidation-Sheet-crosschecking-not-required.html

This incident makes me not to share 100% date with experts. Not to say am not trusting you guys but the previous incident still haunting me. Sorry for this.    
That's exactly my point. It may well be the the number of rows in his table will be different to the customer's. Also the rows may not always align. We need to take this into consideration.
Avatar of Theva

ASKER

Hi,

Looking at the situation, I have no choice to share with you guys my original documents, so that you have better solution. I remove my client name. Here's the file and hope it helps.
ClintsDataTest2-1-.xls
so what is the problem it seems to be working
Other then the extra information at the end of
Cue tone 9
Cue tone 9 (Skycable)
If that is the problem i am on it
 
it dose show problems at line 815
The data comes from sheet1 line 850 and sheet2 815
This must be how this is suposed to point out errors
please advise
 
Clint
Just a thought... would an SQL solution work? Since you have access to both the databases, may be you could write a query to return records based on certain conditions. These conditions can be assigned a number and you could do a conditional formatting based on this column.
yes if he has access to both databases then an SQL solution would do this easier, posibly even if he only has access to 1 it can still work if he recieves the client s data as a spread sheet and has access to the master db.
 
even better to create a new database with linked table and then an import for the client's Excel data.
 
good thought
 
 
Avatar of Theva

ASKER

Hi,

I have tested with some other date data and the errors are not appeared. To make it simple, since the error only exist for certain workbook, can we include this actual split in our search result. Thus we can identified the error shows not because of wrong eatery from my side but merely because miss match line.        
Set Actual_Split = ThisWorkbook.Worksheets("Actual Split")
    If Actual_Split Is Nothing Then
        ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = "Actual Split"
        Set Actual_Split = ThisWorkbook.Worksheets("Actual Split")
    End If
    On Error GoTo 0
    Actual_Split.Cells.Delete
    strErrors = ""
    Reconcile.Cells.Delete
    Client.Cells.Copy Reconcile.Cells
    Reconcile.Range("L3") = ""
    Reconcile.Cells.Interior.ColorIndex = -4142
    datum = 1
    Actual_Split.Range("a1").Resize(UBound(actualsplit) + 1, 1) = False
    Actual_Split.Range("b1").Resize(UBound(actualsplit) + 1, 1) = actualsplit
    For rw = 1 To Reconcile.Range("c" & Reconcile.Rows.Count).End(xlUp).Row
        targetTime = Reconcile.Range("C" & rw)
        If InStr(targetTime, ":") <> InStrRev(targetTime, ":") Then
            targetTime = addTime(CDate(Left(targetTime, InStrRev(targetTime, ":") - 1)), -8)
            lngColor = 8
            For actualIndex = LimitCheck(datum, -3, 1, Actual_Split.Range("b" & Actual_Split.Rows.Count).End(xlUp).Row) To LimitCheck(datum, 3, 1, Actual_Split.Range("b" & Actual_Split.Rows.Count).End(xlUp).Row)
                arrActual = Split(actualsplit(actualIndex, 1), "|")
                ActualTime = Trim(Split(arrActual(0), " - ")(1))
                ActualTime = Left(ActualTime, InStrRev(ActualTime, ":") - 1)
               If arrActual(1) = "AKSSW09HS11A" And Reconcile.Range("i" & rw) = "Cue tone 9 (Skycable)" Or _
                    arrActual(1) = "AKSSW10HS11A" And Reconcile.Range("i" & rw) = "Cue Tones 10 (Starhub)" Or _
                    arrActual(1) = "AKSSW11HS11A" And Reconcile.Range("i" & rw) = "Cue Tones 11" Or _
                    arrActual(1) = "AKSSW12HS11A" And Reconcile.Range("i" & rw) = "Cue Tones 12" Or _
                    InStr(LCase(arrActual(2)), Left(LCase(Reconcile.Range("h" & rw)), 10)) > 0 Or _
                    ActualTime = targetTime _
               Then
                    If Actual_Split.Range("a" & actualIndex) <> True Then
                        lngColor = -4142
                        datum = datum + 1   ' Line in system playlist - start at line 2 given the heading in row 1
                        Actual_Split.Range("a" & actualIndex) = True
                        Actual_Split.Range("c" & actualIndex) = "'" & rw & " - " & actualIndex
                        Exit For
                    End If
                End If
            Next
            If lngColor <> -4142 Then
                Reconcile.Range("D" & rw).Resize(1, 7).Interior.ColorIndex = lngColor
                Debug.Print "Error detected in Planned row " & rw & " actual row (ish) " & datum
                strErrors = strErrors & vbCrLf & "Error detected in Planned row " & rw & " actual row (ish) " & datum
            End If
        End If
    Next
    If strErrors = "" Then
        strErrors = "No Errors reported"
    Else
        strErrors = "Errors reported as follows:" & vbCrLf & strErrors
    End If
    MsgBox strErrors
    
'    Actual_Split.UsedRange.Columns.AutoFit
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Open in new window

ya i can look at it in the morning.
Avatar of Theva

ASKER

Hi,

Thanks, have a good rest then :)
Avatar of Theva

ASKER

Hi

here's the sample data(different tx date)  that I tested without any problem.
ClintsDataFixed.xls
What, "data(different tx date) "
 
I need to know what the code is not doing with a detailed example and a definition of what the code should be doing differently.
 
Clint
Avatar of Theva

ASKER

Hi,

Everyday I have different playlist line-up which is covering 24hrs transmission. The data I tested earlier and the new list belongs to different transmission date. As you noticed, its not showing any lines errors.

The code will check both lines (sheet1&2) with true/false statement. By having this we can easily identify whether the error resulted by line miss match or something else . Please let me know your concern about this approach. If you think this is not necessary, I will omit this.    

   

The last example you up loaded showed no errors because there weren't any. if you change something or delete a line then you will see errors but you can't expect to see errors highlighted if there aren't any.
 
There are no date fields on sheet1 or sheet2 if the two dates that you selected are different but the data except for the date is the same which it is then nothing will be highlighted.
 
If you want it to check if the dates are the same then you have to put a date column on both sheets. If this is not possible then there is nothing we can do my code can’t be made to guess what the date is for the programs.
The code will check both lines (sheet1&2) with true/false statement.
 
The code already dose this that is why it highlights blue if ClientTime AND  AstroTime do not match or if ClientTotalDuration  AND AstroTotalDuration do not match and it also checks to see if Cue tone 9 = AKSSW09HS11A AND if Cue Tones 10 = AKSSW10HS11A.
 
Do you also want it to check if the sheet1 ClientProduct = sheet2 Title? which the don't.

 
 
OR do you want the line highlighted a different color if the lines are simply misaligned?  Which can be done if none of the data match on a line but this is easy to see because if this is so then all time items are highlighted.
 
Play around with this a little more and look at the code so you understand what it is doing.
 
Let me know

 
Clint
 
Avatar of Theva

ASKER

Hi Clint,

highlighting a different color if the lines are simply misaligned sounds great; its superb actually. By looking at the color coding we can easily identify. Hope you integrate this in our consolidation.
Try this i added a column ClientProduct which can ve visualy compaired to ClientTitle looking at the area where a lot of highlighted items begin to show up we can see that:
 
ClientProduct  and  ClientTitle  no longer match at line 35 because the clients list has a missing cue tone item on there sheet.
 
If you want to programicly highlight items that do not look the same i can write code to check to see if the first 7 or 8 letters of ClientTitle  are in ClientProduct  and if not then highlight but because the titles are not exactly the same we can not check for exact matches.
 
Is this helpfull?
 
The file is attached.
 
Good Luck
 
Clint

ClintsDataFixed-2-.xls
ok i will start working on the color differeince if the above is ok to keep the new added field.
Clint
 
Avatar of Theva

ASKER

Hi Clint,

Wow! if we able to check the title than I would say we're covered the whole spectrum. Hope you can program this as well.

ASKER CERTIFIED SOLUTION
Avatar of csmart2301
csmart2301

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Theva

ASKER

Hi Clint,

Really helps, its not only checking the time,duration but up to titles. Amazing! and I really like it. Thanks for your help to make this works superbly. Actually you provide me more than what I expected. Again, Thanks a lot for your brilliant gift.
Thank you as well, I am glad it is working.
 
Clint
Avatar of Theva

ASKER

am not happy with the points given by EE, lousy mark!!!!
The letter grade is what matters on my end an A on a 500 point question = 2000 points
The rating is caculated by how quickly the question was answered and how many post it took to reach a solution and a few other things. so low ratings show users that they may have trouble using this post to solve future problems that they may have.
 
So it's all good.
Avatar of Theva

ASKER

Hi,

One  more thing, how to highlight first row in "Consolida"  sheet? This is to differentiate data and header. Sorry for troubling you with this.
At the end of the macro add this line as shown in this code
 
         .ColorIndex = 48

 
*******************************************************

Next i
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "ClientTime"
    Range("b1").Select
    ActiveCell.FormulaR1C1 = "AstroTime"
    Range("c1").Select
    ActiveCell.FormulaR1C1 = "ClientTotalDuration "
    Range("d1").Select
    ActiveCell.FormulaR1C1 = "AstroTotalDuration"
    Range("e1").Select
    ActiveCell.FormulaR1C1 = "ClientTitle"
    Range("f1").Select
    ActiveCell.FormulaR1C1 = "ClientProduct"
    Range("g1").Select
    ActiveCell.FormulaR1C1 = "ClientInfo/Segment"
    Range("h1").Select
    ActiveCell.FormulaR1C1 = "MediaID"
        Range("A1:h1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
       .ColorIndex = 48
   End With
    Columns("A:A").ColumnWidth = 12.86
    Columns("B:B").ColumnWidth = 15.57
    Columns("C:C").ColumnWidth = 15.71
    Columns("D:D").ColumnWidth = 16.29
    Columns("E:E").ColumnWidth = 42.14
    Columns("f:f").ColumnWidth = 42.14
    Columns("g:g").ColumnWidth = 16.14
    Columns("h:h").ColumnWidth = 18.57
Range("A1").Select
Application.DisplayAlerts = True
End Sub
Add just the highlighted line exactly where it is shown in this clipping from the end of the cons macro
 
Clint
 
Avatar of Theva

ASKER

Hi,

Thanks.
Avatar of Theva

ASKER

Hi Clint,

Hope you fine there. If you have time please look at this Q, I need your help:

https://www.experts-exchange.com/questions/25370436/Create-condition-rules-when-clearing-the-content-of-the-sheets.html