Forum Discussion

JoAvg's avatar
JoAvg
Brass Contributor
Jan 22, 2023
Solved

Combine macros in one

I have these two codes in sheet TOMH. I would like to combine these in one macro.   1. I would like to run the code from sheet As_Built. 2. The executed order of the macro is as depicted here: fi...
excel
Macros and VBA
office 365
  • HansVogelaar's avatar
    HansVogelaar
    Jan 22, 2023

    JoAvg 

    No need to wait - the second part of the code won't be executed before the first part ends.

    Sub TransposeAndSaveAsText()
    Dim x As Range, y As Range, z As Range
    Dim ws As Worksheet
    Dim f As Integer
    Dim r As Long
'   ------------------------------------------------------
    Set ws = Worksheets("TOMH")
    Set y = ws.Range("DA2")
    For Each z In ws.Range("CF1:CU21").Columns
        For Each x In z.Cells
            If Len(x.Value) > 0 Then
                y.Value = x.Value
                Set y = y.Offset(1, 0)
            End If
        Next x
    Next z
    f = FreeFile
    Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\EDA_THESS_DWG\EXEC.scr" For Output As #f
    r = 2
    Do While ws.Range("DB" & r).Value <> ""
        Print #f, ws.Range("DB" & r).Value
        r = r + 1
    Loop
    Close #f
End Sub
HansVogelaar's avatar
HansVogelaar
MVP
Jan 22, 2023

JoAvg 

No need to wait - the second part of the code won't be executed before the first part ends.

Sub TransposeAndSaveAsText()
    Dim x As Range, y As Range, z As Range
    Dim ws As Worksheet
    Dim f As Integer
    Dim r As Long
'   ------------------------------------------------------
    Set ws = Worksheets("TOMH")
    Set y = ws.Range("DA2")
    For Each z In ws.Range("CF1:CU21").Columns
        For Each x In z.Cells
            If Len(x.Value) > 0 Then
                y.Value = x.Value
                Set y = y.Offset(1, 0)
            End If
        Next x
    Next z
    f = FreeFile
    Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\EDA_THESS_DWG\EXEC.scr" For Output As #f
    r = 2
    Do While ws.Range("DB" & r).Value <> ""
        Print #f, ws.Range("DB" & r).Value
        r = r + 1
    Loop
    Close #f
End Sub

Resources