Combining Macros

[RuinAerlin]

Hi all,

New to the forum and really quite new to macros in general - so apologies if you look at what I've written and go "WTF was she thinking?"

I have a few macros I need to run to get a particular output into something my database can import - and then a manual change files into .csv I'm sure there is a macro or a change to one of the macros I run to get this to work - but I'm struggling a little with how to combine them all.
1st macro:

 Sub SSEstep1()'
' SSEstep1 Macro
'
' All lines that begin with an apostrophe (') are remarks and are not
   ' required for the macro to run.


      ' Dimension Variables.
      Dim ResultStr As String
      Dim FileName As Variant
      Dim FileNum As Integer
      Dim Counter As Double


      ' Ask User for file's name.
      FileName = Application _
 .GetOpenFilename("Text Files (*.txt), *.txt")


      ' Check for no entry.
      If FileName = False Then End


      ' Get next available file handle number.
      FileNum = FreeFile()


      ' Open text file for input.
      Open FileName For Input As #FileNum


      ' Turn screen updating off.
      Application.ScreenUpdating = False


      ' Create a new workbook with one worksheet in it.
      Workbooks.Add template:=xlWorksheet


      Counter = 1
      ' Loop until the end of file is reached.
      Do While Seek(FileNum) <= LOF(FileNum)
         ' Display importing row number on status bar.
          Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
          ' Store one line of text from file to variable.
          Line Input #FileNum, ResultStr
          ' Store variable data into active cell.
          If Left(ResultStr, 1) = "=" Then
             ActiveCell.Value = "'" & ResultStr
          Else
             ActiveCell.Value = ResultStr
          End If
          If ActiveCell.Row = 65536 Then
             ' If on the last row then add a new sheet.
             ActiveWorkbook.Sheets.Add
          Else
             ' If not the last row then go one cell down.
             ActiveCell.Offset(1, 0).Select
          End If
          ' Increment the counter by 1.
          Counter = Counter + 1
      ' Start again at top of 'do while' statement.
      Loop
      ' Close the open text file.
      Close
      ' Remove message from status bar.
      Application.StatusBar = False


   End Sub

2nd macro:

 Sub cycle()

Dim wk As Worksheet
For Each wk In ActiveWorkbook.Worksheets
wk.Activate


    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 4), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.NumberFormat = "0"
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[1],""DD/MM/YYYY"")&"" ""&TEXT(RC[2],""hh:mm"")"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B65536")
    Range("B1:B65536").Select
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
Next wk
End Sub

3rd macro:

 Sub CreateNewWBS()Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String


    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/" & ws.Name
        ws.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws
End Sub

I'd appreciate if someone can have a look at the ones I'm running to see if they can help me streamline, and if possible create a single macro that can "do it all" and save me spending hours a week changing to csv files. If you can explain, I can learn and perhaps do it myself next time.

 

[jim may]

Without getting too much into this.. have you just tried
combining them into Macro4, like so...

Sub Macro4
YourMacro1
YourMacro2
YourMacro3
End sub

 

[RCBricker]

Hi all,

New to the forum and really quite new to macros in general - so apologies if you look at what I've written and go "WTF was she thinking?"

I have a few macros I need to run to get a particular output into something my database can import - and then a manual change files into .csv I'm sure there is a macro or a change to one of the macros I run to get this to work - but I'm struggling a little with how to combine them all.
1st macro:

 Sub SSEstep1()'
' SSEstep1 Macro
'
' All lines that begin with an apostrophe (') are remarks and are not
   ' required for the macro to run.


      ' Dimension Variables.
      Dim ResultStr As String
      Dim FileName As Variant
      Dim FileNum As Integer
      Dim Counter As Double


      ' Ask User for file's name.
      FileName = Application _
 .GetOpenFilename("Text Files (*.txt), *.txt")


      ' Check for no entry.
      If FileName = False Then End


      ' Get next available file handle number.
      FileNum = FreeFile()


      ' Open text file for input.
      Open FileName For Input As #FileNum


      ' Turn screen updating off.
      Application.ScreenUpdating = False


      ' Create a new workbook with one worksheet in it.
      Workbooks.Add template:=xlWorksheet


      Counter = 1
      ' Loop until the end of file is reached.
      Do While Seek(FileNum) <= LOF(FileNum)
         ' Display importing row number on status bar.
          Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
          ' Store one line of text from file to variable.
          Line Input #FileNum, ResultStr
          ' Store variable data into active cell.
          If Left(ResultStr, 1) = "=" Then
             ActiveCell.Value = "'" & ResultStr
          Else
             ActiveCell.Value = ResultStr
          End If
          If ActiveCell.Row = 65536 Then
             ' If on the last row then add a new sheet.
             ActiveWorkbook.Sheets.Add
          Else
             ' If not the last row then go one cell down.
             ActiveCell.Offset(1, 0).Select
          End If
          ' Increment the counter by 1.
          Counter = Counter + 1
      ' Start again at top of 'do while' statement.
      Loop
      ' Close the open text file.
      Close
      ' Remove message from status bar.
      Application.StatusBar = False


   End Sub

2nd macro:

 Sub cycle()

Dim wk As Worksheet
For Each wk In ActiveWorkbook.Worksheets
wk.Activate


    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 4), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Selection.NumberFormat = "0"
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = _
        "=TEXT(RC[1],""DD/MM/YYYY"")&"" ""&TEXT(RC[2],""hh:mm"")"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B65536")
    Range("B1:B65536").Select
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
Next wk
End Sub

3rd macro:

 Sub CreateNewWBS()Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String


    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/" & ws.Name
        ws.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws
End Sub

I'd appreciate if someone can have a look at the ones I'm running to see if they can help me streamline, and if possible create a single macro that can "do it all" and save me spending hours a week changing to csv files. If you can explain, I can learn and perhaps do it myself next time.

The question is how do you want these to run? Will you always do all three macros no matter what? or is there a time you might want to control when one or the other fires?

if you want them to run together always you can link them with CALLS

so at the end of the first macro put:

call cycle

that will cause the second macro to fire.

then

call CreateNewWBS

at the end of the second macro.

You can also just copy the code and paste one after the other in the same macro.

It will be easier to edit or chase bugs if you use separate sub-routines.

Finally,

Try to never use select. or Activate. There will be times but they are rare. A good clue that you do not need them is one line ending in select and the next line starting with selection.

Here is your second macro with a little cleaning.

Sub cycle()
Dim wk As Worksheet
Dim lngrow As Long
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

    For Each wk In ActiveWorkbook.Worksheets
        wk.Activate
        With wk
            Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
                :=Array(Array(1, 9), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 4), Array(6, 1), _
                Array(7, 1)), TrailingMinusNumbers:=True
            Columns("A:A").NumberFormat = "0"
            Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            lngrow = Range("B" & .ROWS.Count).End(xlUp).Row
            Range("B1:B" & lngrow).FormulaR1C1 = _
                "=TEXT(RC[1],""DD/MM/YYYY"")&"" ""&TEXT(RC[2],""hh:mm"")"
        
            Range("B1:B" & lngrow).Copy
            Range("B1").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            Columns("C:D").Delete Shift:=xlToLeft
        End With
    Next wk
End Sub

 

[RuinAerlin]

Jim - aye I tried that, but with the sheer number of macros I have (50 odd?) it's hard to find them in a list if I have to add another one, so I was trying to reduce the number of macros I have.

RCBricker that is exactly what I was looking for thank you - I wasn't sure if a copy & paste would make it run in order (I'm terrible at scripting). I'm not sure I follow how the select/active thing works, assuming lngrow is line grow and ......oooh that's cool. So If I were to use "Sheets("Sheet2").Select" how would that translate to a "just use the sheet you are on please"? (again this will save me time on other macros, including a further run on this piece of work I )

Can either of you advise how I get macro 3 to save the split tabs as a .csv rather than something without a file extension? Sorry I've been plugging bits of macros together for a while and getting a bit lost. Must find a "learn to macro" class around here.

 

[RCBricker]

Jim - aye I tried that, but with the sheer number of macros I have (50 odd?) it's hard to find them in a list if I have to add another one, so I was trying to reduce the number of macros I have.

RCBricker that is exactly what I was looking for thank you - I wasn't sure if a copy & paste would make it run in order (I'm terrible at scripting). I'm not sure I follow how the select/active thing works, assuming lngrow is line grow and ......oooh that's cool. So If I were to use "Sheets("Sheet2").Select" how would that translate to a "just use the sheet you are on please"? (again this will save me time on other macros, including a further run on this piece of work I )

Can either of you advise how I get macro 3 to save the split tabs as a .csv rather than something without a file extension? Sorry I've been plugging bits of macros together for a while and getting a bit lost. Must find a "learn to macro" class around here.

The best way to see how your code works is to toggle through it with F8 and watch what happens. That is how I learned. Stealing from the internet and then going through the code line for line.

lngROW is a long variable (lng for long, rng for range, int for interger, var for variant, etc).

so the line is:

lngrow = Range("B" & .ROWS.Count).End(xlUp).Row

What it does is goes to the B column and to the last cell in that column so B1048576.

It then moves up through the B column to the first cell that is not empty.

the .row portion then captures the row number.

This allows you to set the next line from the first line of data through to the last row of data.

As for:

"Sheets("Sheet2").Select" how would that translate to a "just use the sheet you are on

lets say you wanted to copy the whole of sheet2

Sheets("Sheet2").select
selection.copy

is the same as

Sheets("Sheet2").copy

You will find that some things require an active object. There are ways to write the code to point to the object, but I have found it easier to just select the object and then write the code within a WITH block.

So back to our lngROW example...

lngrow = Range("B" & .ROWS.Count).End(xlUp).Row

does not need the sheet identified in your code because of the WITH block set up with the line 'With wk' which sets the object as the worksheet represented by the wk worksheet variable.

you can not find the last row of a worksheet with out the worksheet being identified as the object.

so either

with wk
lngrow = Range("B" & .ROWS.Count).End(xlUp).Row
end with

or

lngrow = Range("B" & wk.ROWS.Count).End(xlUp).Row

notice that it now says wk.rows.count

this identifies which worksheet to get the count from.

I do not work in .csv files so I do not need to do that often. I would simply go to google and type excel vba save file as .csv

HTH