VBA code to import new data to dashboard

JasonMS2022

New Member
Joined
Dec 16, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Good day all,

I'm attempting to build a dashboard of Incident Ticketing data for our IT office. Every morning I extract a new Incident report from ServiceNow and import that worksheet into the dashboard excel file. I then try to update each row by matching ticket numbers between the new incident report data to the existing dashboard incident data, or if the tickets don't exist in the dashboard then append it to the end of the dataset/table.

So far this is the code I'm trying to use but it is running extremely long (30+ minutes and I finally stopped the code) and I'm only working with about 3000-3500 rows of data (36 columns) not all that huge. Any suggestions on a better method or ways to streamline this code would be appreciated.

Basic requirements: Scan the new dataset ticket numbers, which are in Column A on a worksheet named [Page 1]. Then check the 'new' ticket number against the existing data set tickets, also Column A but on a worksheet named [INCDATA]. If a match is found between the two, copy the matching row of new data from the 'New' [Page 1] over the 'Old' [INCDATA], if no match is found copy the 'New' [Page 1] row of data to the end of the 'Old' [INCDATA] dataset.

Thanks!!
Jason

VBA Code:
Sub DataScrub()

    Dim wsNew As Worksheet, wsINC As Worksheet
    Dim lrow As Integer, nrow As Integer, i As Integer
    Dim str As String, str2 As String
    Dim fndrng As Range
        Set wsNew = ThisWorkbook.Sheets("Page 1")
        Set wsINC = ThisWorkbook.Sheets("INCDATA")
        lrow = wsNew.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
        nrow = wsINC.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row + 1
        i = 2
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Do While i <= lrow
        Set fndrng = wsINC.Range("A:A").Find(what:=wsNew.Cells(i, 1))
        str = "A" & i & ":AF" & i
        
        If fndrng Is Nothing Then
            str2 = "A" & nrow
            nrow = nrow + 1
            Else
            str2 = "A" & fndrng.Row
        End If
            
        wsNew.Range(str).Copy
        wsINC.Range(str2).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
                
    Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub


Here is a second set of code I've also tried but it errors out on the J-Loop after about 500-550 rows...

VBA Code:
'  Sub DataScrub2()
'
'    Dim wsNewew As Worksheet, wsINC As Worksheet
'    Dim lrow As Integer, nrow As Integer, i As Integer, j As Integer, rw As Integer
'    Dim fndrng As Range
'    Set wsNewew = ThisWorkbook.Sheets("Page 1")
'    Set wsINC = ThisWorkbook.Sheets("INCDATA")
'    lrow = wsNewew.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
'    nrow = wsINC.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row + 1
'
'    i = 2
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual
'    Do While i <= lrow
'        Set fndrng = wsINC.Range("A:A").Find(what:=wsNewew.Cells(i, 1))
'        If fndrng Is Nothing Then
'            rw = nrow
'            nrow = nrow + 1
'        Else
'            rw = fndrng.Row
'        End If
'        For j = 1 To 36
'            wsINC.Cells(rw, j) = wsNewew.Cells(i, j)
'        Next j
'        wsNewew.Rows(i).Delete
'        lrow = lrow - 1
'    Loop
'    Application.ScreenUpdating = True
'    Application.Calculation = xlCalculationAutomatic
'
' End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Ok, I've decided to go with the second method as it is faster and I found the problem was one of the cells contained an excessively large amount of data causing the formula to fail.
 
Upvote 0

Forum statistics

Threads
1,214,592
Messages
6,120,433
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top