actuallife
actuallife

Reputation: 89

How do I use VBA to copy rows in Excel sheet and send them to a CSV?

What I want to do is pretty simple, I just have literally 0 experience with VBA. I have experience coding in other languages though (java, js, c, etc.).

What I am trying to do is go through the rows of an excel sheet, see if the integer value in the first cell of each row is within a certain range, and if it is, then copy that entire row and paste it into a new sheet that will be saved as a CSV.

I am able to go through the column and check the first cell value in each row, I now need to know how to take that corresponding row, copy it, and paste it in the CSV sheet.

For example, say this is the excel sheet I am trying to parse:

enter image description here

Say the user specifies that they want to grab all rows where the value in the first cell of that row is between 3 and 9 (rows 6-8, 11, 13-15). My VBA code would then go through all the rows and grab only the rows that fit the criteria above, and then send those rows to a new sheet that would look something like this:

enter image description here

This is what my code looks like right now, which goes down Column A, and checks the value in first cell of each row. I am not sure how to grab each row, and then send it to the new sheet

Sub exportDesiredRowsToCSVSheet()

    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "myCSV"
    MsgBox "Sheet 'myCSV' was created"     'create new sheet that I will save as CSV at the end
    
    
    firstL = Application.InputBox("first line item num", "please enter num", , , , , , 1) 'gets user to input lower bound
    lastL = Application.InputBox("last line item num", "please enter num", , , , , , 1) 'gets user to input upper bound

    
    For Each Row In Range("A:A")        'go through rows in column A
        For Each Cell In Row            'go through first cell in each row of column A
            If Cell.Value >= firstL And Cell.Value <= lastL Then    'if the value in the cell is in the range
                'Here I want to take the desired rows and copy/paste them to a the newly created 'myCSV' sheet
                
            End If
        Next
    Next
        
    

End Sub

Any help is appreciated!

Upvotes: 2

Views: 1127

Answers (2)

user3259118
user3259118

Reputation:

I suspect your knowledge of VBA far exceeds mine of java etc. The following basic code will do what you want - following on from @BigBen's suggestions regarding finding the last row & using a filter to copy all rows at once.

It assumes the code is in that workbook. You'll need to add your own error traps for invalid user input.

CODE EDITED AS PER OP's REQUIREMENTS

Option Explicit
Sub CopyToCSV()
Dim LastRow As Long, FirstL As Integer, LastL As Integer

FirstL = InputBox("Pick the first Row number", "First Row Selection")
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

'EDIT - maximum number in range selected automatically
LastL = Application.WorksheetFunction.Max(Sheet1.Range("A2:A" & LastRow))

'Left in case you change your mind
'LastL = InputBox("Pick the final Row number", "Final Row Selection")

'***************************************************
'You'll need to determine your own Error Traps here
'***************************************************

With Sheet1
    .Range("A:A").AutoFilter Field:=1, Criteria1:=">=" & FirstL, _
    Operator:=xlAnd, Field:=1, Criteria2:="<=" & LastL
End With

'Create new sheet rather than new csv workbook
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)).Name = "myCSV"

'Add new headers - change to suit
Sheets("myCSV").Cells(1).Resize(1, 5).Value = _
Array("NewH1", "NewH2", "NewH3", "NewH4", "NewH5")

'Copy to new sheet in this workbook assumes data is on sheet 1
'Copy values only (and formats?)
With Sheet1.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    .EntireRow.Copy
    Sheets("myCSV").Range("A2").PasteSpecial Paste:=xlPasteValues
    '*** UNCOMMENT THE NEXT LINE IF YOU ALSO WANT FORMATS COPIED ***
    'Sheets("myCSV").Range("A2").PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False
Sheet1.AutoFilterMode = False

End Sub

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 54983

Copy with Criteria Using Loop

Option Explicit

Sub exportDesiredRowsToCSVSheet()
    
    ' Define constants.
    Const srcName As String = "Sheet1"
    Const dstName As String = "myCSV"
    Const cCol As String = "A"
    Const FirstRow As Long = 2
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    ' Define Source worksheet.
    Dim src As Worksheet
    Set src = wb.Worksheets(srcName)
    
    ' Determine min and max.
    Dim minID As Long
    minID = Application.Min(src.Columns(cCol))
    Dim maxID As Long
    maxID = Application.Max(src.Columns(cCol))
    
    ' Get user input.
    Dim FirstL As Variant
    FirstL = Application.InputBox("First line item number", "Enter Number", _
        minID, , , , , 1)
    If FirstL = False Then
        MsgBox "User canceled."
        Exit Sub
    End If
    Dim LastL As Variant
    LastL = Application.InputBox("Last line item number", "Enter Number", _
        maxID, , , , , 1)
    If LastL = False Then
        MsgBox "User canceled."
        Exit Sub
    End If
    
    ' Determine rows.
    FirstL = Application.Match(FirstL, src.Columns(cCol), 0)
    If IsError(FirstL) Then
        FirstL = Application.Match(minID, src.Columns(cCol), 0)
    End If
    LastL = Application.Match(LastL, src.Columns(cCol), 0)
    If IsError(LastL) Then
        LastL = Application.Match(maxID, src.Columns(cCol), 0)
    End If
    If LastL < FirstL Then
        maxID = FirstL
        FirstL = LastL
        LastL = maxID
    End If
    
    ' Define Destination worsheet.
    Dim dst As Worksheet
    On Error Resume Next
    Set dst = wb.Worksheets(dstName)
    On Error GoTo 0
    If Not dst Is Nothing Then
        Application.DisplayAlerts = False
        dst.Delete
        Application.DisplayAlerts = True
    End If
    Set dst = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    dst.Name = dstName
    
    ' Copy form Source to Destination worksheet.
    Dim rng As Range
    Dim cel As Range
    Dim dRow As Long
    src.Rows(1).Copy dst.Rows(1)
    Set rng = src.Range(src.Cells(FirstL, cCol), src.Cells(LastL, cCol))
    dRow = 1
    For Each cel In rng.Cells
        If cel.Value > 0 Then
            dRow = dRow + 1
            cel.EntireRow.Copy dst.Rows(dRow)
        End If
    Next cel
    
    ' Save as '.csv'.
    dst.Move ' or 'dst.Copy' if you wanna keep a copy in Source workbook.
    With ActiveWorkbook
        '.SaveAs ThisWorkbook.Path & "\" & dstName, xlCSV
        '.FollowHyperlink ThisWorkbook.Path ' Show in windows explorer.
        '.Close
    End With
    
    'wb.Save
    
    ' Inform user.
    MsgBox "'" & dstName & "' was created", vbInformation

End Sub

Upvotes: 1

Related Questions