Link to home
Start Free TrialLog in
Avatar of ktjamms2
ktjamms2Flag for United States of America

asked on

Modifying a Recorded Macro

I recorded this macro and I would like to be able to run it on every worksheet in the workbook.

I tried adding for each workbook and next workbook to the macro I recorded, but it doesen't go to the next worksheet.

Also, at the end of the data is some "stuff" I would like to delete, but somehow doesn't seem to get recorded in my macro. Please see screen capture to see what I mean.


Here is what I have:

**************************************************************************
Sub FormatColoradoData()

Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets

'START OF RECORDED MACRO

    Range("A5:A7").Select
    Selection.Copy
    Range("J5:J7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("K5:K7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J5:J7").Select
    ActiveCell.FormulaR1C1 = "WELLNAME"
    Range("K5:K7").Select
    ActiveCell.FormulaR1C1 = "WELLNO"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=R1C1"
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=R2C2"
    Range("J8:K8").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    Range("J37:K37").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K8").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E1:G1").Select
    Selection.Delete Shift:=xlUp
    Range("E1:G2").Select
    Range("E3:G3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1:G3").Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("H1:H3").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E1:H3").Select
    Selection.UnMerge
    Range("D1:D3").Select
    Selection.Copy
    Range("E1:E3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("F1:F3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1:G3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1:F3").Select
    ActiveCell.FormulaR1C1 = "CASING PSI"
    Range("G1:G3").Select
    ActiveCell.FormulaR1C1 = "LINE PSI"
    Range("F4").Select
   
   
   
    Range("G1:G3").Select
    Selection.Copy
    Range("H1:H3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("I1:I3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").ColumnWidth = 14.14
   
   

    Range("A4").Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range("B34").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
   
  Next WS
 
End Sub
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
Why attach a picture in a Word document? An Excel file would be much more helpful.
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
Shortcut would be to add ws.activate after the For line.
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

I'm trying to get the worksheets in the workbook formatted to import into a database table. The file I attached is just a sample, but the acutal file consists of about 50+ worksheets.
ASKER CERTIFIED SOLUTION
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
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 ktjamms2
ktjamms2
Flag of United States of America image

ASKER

How can I handle the merged cells. It triggers an alert that requires a click on OK? Also...I need to exclude the first worksheet because it has data that the other worksheets are using.
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
Before you post a question why don't you take a few minutes to think about everything you need and set it out properly? By introducing new requests you are effectively devaluing my time because I have to go over old ground which I could have covered the first time.
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

Really do apologize...The merged cells is a problem I figured I could live with if I had to, and overlooked the fact that the other sheets were using the first one until I saw the !ref errors after I ran the macro. Been a long day!
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
Insert the name of the sheet to be excluded where indicated:
Sub FormatColoradoData()

Dim WS As Worksheet
Dim n As Long
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Name of first sheet here" Then
WS.Activate
Cells.UnMerge
'
' FormatColoradoData Macro
'

'
    Range("A5:A7").Select
    Selection.Copy
    Range("J5:J7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("K5:K7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J5:J7").Select
    ActiveCell.FormulaR1C1 = "WELLNAME"
    Range("K5:K7").Select
    ActiveCell.FormulaR1C1 = "WELLNO"
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=R1C1"
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=R2C2"
    Range("J8:K8").Select
    Selection.Copy
    Range("A8").Select
    Selection.End(xlDown).Select
    Range("J37:K37").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K8").Select

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Rows("1:4").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("E1:G1").Select
    Selection.Delete Shift:=xlUp
    Range("E1:G2").Select
    Range("E3:G3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1:G3").Select
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("H1:H3").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E1:H3").Select
    Selection.UnMerge
    Range("D1:D3").Select
    Selection.Copy
    Range("E1:E3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("F1:F3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1:G3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1:F3").Select
    ActiveCell.FormulaR1C1 = "CASING PSI"
    Range("G1:G3").Select
    ActiveCell.FormulaR1C1 = "LINE PSI"
    Range("F4").Select
    
    
    
    Range("G1:G3").Select
    Selection.Copy
    Range("H1:H3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("I1:I3").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").ColumnWidth = 14.14
    
    

    Range("A4").Select
    Selection.End(xlDown).Select
    Rows("34:34").Select
    Range("B34").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("A1:A3").Select
    
    n = Range("A" & Rows.Count).End(xlUp).Row - 4
    Range("A" & n).Resize(4).EntireRow.Delete
End If
  Next WS
 
End Sub

Open in new window

Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

I tried your last post, but I got a runtime error "Method 'Range' of object '_Global' failed"

highlights on:
  Range("A" & n).Resize(4).EntireRow.Delete
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
I tried the code on your sample and it worked for me.
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

Sorry...my first sample didn't include the first page that the other sheets referance. Please try it with this sample.
Book1.xlsm
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

It seems to be running the macro on Personal.xlsb....how do I fix that? I tried hiding it, but it still runs on it anyway.
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image
If I run the code I provided on that workbook it works, but I suggest you remove the lines which refer to merging cells.
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

How can I store the macro in personal (so I can use it on multiple spreadsheets) and not have it run on the personal spreadsheet? That seems to be the problem with the error. If I put the macro in this worksheet, it runs fine. But, when it is stored in personal, it blows up.
Avatar of ktjamms2
ktjamms2
Flag of United States of America image

ASKER

Thank-you!