PDA

View Full Version : Data migration between tabs using VBA



polishfc
12-20-2019, 02:21 PM
Hi All,

As an overview, I have a spreadsheet built with a few macros that copies raw data from one tab and pastes it into other tabs based on the status. Both the raw data and the data in the other tabs contain both current and historic line items so I have code in place that only runs the “copy-paste” code if an ID is new and unique. Now that the dataset has grown the macro is excruciatingly slow, so I would like to get your opinion/critique on how to make it more efficient

I’ve put together a rudimentary sample set and basically copy and pasted the VBA code from my actual dataset to run off of the command button in the “Raw Data” tab.

Quick explanation of how the macro is ideally supposed to work:

Scans through the “Open” tab flags any line items with unique ID Numbers in the “Raw Data” tab than copy and paste cells to certain columns (as the columns between the two tabs do not line up)

Any help is greatly appreciated. Thanks.

Paul_Hossler
12-20-2019, 03:04 PM
I think that the looping was adding the extra run time

See if something like this is faster

Future -- if new data is ALWAYS added to the end of Data, then it would be much faster if there's a lot of data to check from bottom (newest data) going up and adding data to the sheets until a match is found and then just exit everything





Option Explicit


'columns in Data sheet
Const colID As Long = 1
Const colStatus As Long = 2
Const colName As Long = 3
Const colJob As Long = 4
Const colHours As Long = 5
Const colOffice As Long = 6


Public Sub CheckNewRecordOpenTest()
Dim wsData As Worksheet
Dim wsOpen As Worksheet, wsClosed As Worksheet, wsFilled As Worksheet
Dim n As Long, iData As Long, iNew As Long
Dim intsh2Row As Integer

Set wsData = Worksheets("Raw Data")
Set wsOpen = Worksheets("Open")
Set wsClosed = Worksheets("Closed")
Set wsFilled = Worksheets("Filled")


With wsData
For iData = 2 To .Cells(1, 1).CurrentRegion.Rows.Count
Select Case LCase(.Cells(iData, colStatus).Value)

' 1 2 3 4 5 6
'Name Job Description Hours Office ID Number Status
Case "open"
n = 0
On Error Resume Next
n = Application.WorksheetFunction.Match(.Cells(iData, colID).Value, wsOpen.Columns(5), 0)
On Error GoTo 0

If n = 0 Then ' new one so add to end
iNew = wsOpen.Cells(wsOpen.Rows.Count, 5).End(xlUp).Row + 1

wsOpen.Cells(iNew, 1).Value = .Cells(iData, colName).Value
wsOpen.Cells(iNew, 2).Value = .Cells(iData, colJob).Value
wsOpen.Cells(iNew, 3).Value = .Cells(iData, colHours).Value
wsOpen.Cells(iNew, 4).Value = .Cells(iData, colOffice).Value
wsOpen.Cells(iNew, 5).Value = .Cells(iData, colID).Value
wsOpen.Cells(iNew, 6).Value = "Open"
End If


' 1 2 3 4 5 6
'Status Name Job Description Hours Office ID Number
Case "closed"
n = 0
On Error Resume Next
n = Application.WorksheetFunction.Match(.Cells(iData, colID).Value, wsClosed.Columns(6), 0)
On Error GoTo 0

If n = 0 Then ' new one so add to end
iNew = wsClosed.Cells(wsClosed.Rows.Count, 5).End(xlUp).Row + 1

wsClosed.Cells(iNew, 1).Value = "Closed"
wsClosed.Cells(iNew, 2).Value = .Cells(iData, colName).Value
wsClosed.Cells(iNew, 3).Value = .Cells(iData, colJob).Value
wsClosed.Cells(iNew, 4).Value = .Cells(iData, colHours).Value
wsClosed.Cells(iNew, 5).Value = .Cells(iData, colOffice).Value
wsClosed.Cells(iNew, 6).Value = .Cells(iData, colID).Value
End If

' 1 2 3 4 5 6
'Job Description ID Number Status Name Hours Office
Case "filled"
n = 0
On Error Resume Next
n = Application.WorksheetFunction.Match(.Cells(iData, colID).Value, wsFilled.Columns(2), 0)
On Error GoTo 0

If n = 0 Then ' new one so add to end
iNew = wsFilled.Cells(wsFilled.Rows.Count, 5).End(xlUp).Row + 1

wsFilled.Cells(iNew, 1).Value = .Cells(iData, colJob).Value
wsFilled.Cells(iNew, 2).Value = .Cells(iData, colID).Value
wsFilled.Cells(iNew, 3).Value = "Filled"
wsFilled.Cells(iNew, 4).Value = .Cells(iData, colName).Value
wsFilled.Cells(iNew, 5).Value = .Cells(iData, colHours).Value
wsFilled.Cells(iNew, 6).Value = .Cells(iData, colOffice).Value
End If
End Select
Next iData
End With


End Sub