I am a longtime macro developer in extra basic. We are going to move to Reflections in a couple weeks and I am testing all the macros to ensure they will work. I've been fairly successful except for one problem and that is that I get a Extra basic error 55 or 58. The thing is not consistent though. I used the same code two days ago all day and then today I get the error each time I try to run it. I'll send some code. I think I need to somehow strengthen it so it doesn't fail so easily if that makes sense since it's a runtime error. I just can't figure out why it happens sometimes and not others. I know I should do this in Excel but I don't do VBA very well and I can't deploy it as easy as I can the reflections code.
'--------------------------------------------------------------------------------
Macro will move records from No Results to SAME or MORE after performing
' a different macro. If it states returns pulled with no ref or bal due
' and col 44 indicates empty and col23 states "no return in the cell"
'--------------------------------------------------------------------------------
Option Explicit
Dim objExcel as Object, objWorkBook as Object, scrErr as String
Dim xlRow as Integer
Declare Sub GetExcel()
Sub Main()
'-------------------------------------------------------------------------
Call GetExcel()
'-------------------------------------------------------------------------
' This section of code contains the recorded events
Dim xlNRTab, xlSMTab, objSameMoreTxt as String
Dim xl44Col as String , xl42Col, xl23Col as String, xl11Col as String
Dim xl8Col, xlMove
'SET ROW NUMBER
xlNRTab = "2"
xlSMTab = Inputbox ("Enter first available Same or More row number.")
If xlSMTab = "" Then
xlSMTab = "2"
End If
'BEGIN LOOPING THROUGH THE RECORDS
Do
doevents
'CAPTURE DATA IN THESE COLUMNS
xl42Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 42)
xl23Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 23 )
xl11Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 11 )
If (xl23Col = "TransId is not in R200") Then
If xl42col = 0 Then 'COL11 = "SAME"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)= "SAME"
xlMove = 1
ElseIf xl42col <0 Then 'COL11 = "MORE"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)= "MORE"
xlMove = 1
Elseif xl42col >0 Then 'COL11 = "LESS"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)="Less"
xlMove = 1
End If
End If
If xlMove = 1 Then
'GET DATA FOR SAME OR MORE SHEET
objWorkBook.Worksheets("No Results").Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Copy
'PASTE IT IN SAME OR MORE SHEET
objWorkbook.Worksheets("Same or More").Select
objWorkbook.Worksheets("Same or More").Rows(xlSMTab).Select
objWorkBook.ActiveSheet.Paste
xlSMTab = xlSMTab + 1
'REMOVE IT FROM NO RESULTS
objWorkBook.Worksheets("No Results").Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Delete
xlNRTab = xlNRTab - 1
End If
xl42Col = 0
xl8Col = ""
xlMove = 0
doevents
xlNRTab = xlNRTab + 1
xl8Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 8 )
Loop until xl8Col = ""
msgbox "Macro is done"
End Sub
'--------------------------------------------------------------------------
Sub GetExcel()
Dim objExcel as Object
'START EXCEL
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel is Nothing Then
Set objExcel = CreateObject("Excel.Application")
If objExcel is Nothing Then
msgBox ("Cannot open Excel.")
Stop
End If
End If
'OPEN SPREADSHEET
Dim fileName as String, ExcelPath as String, nret, r, tmpId as String
'XXXX HAS ALREADY OPENED THE TEMPLATE AND DOWNLOADED DATA. THEN DID
'SAVEAS xxxxxxx Returns1.xlsx TO THEIR DESKTOP.
'OPEN SAME FILE TO FIX 'NO RESULTS'
tmpId = InputBox("Enter your userId, e.g., (A1234)")
ExcelPath = "C:\Users\" & tmpId & "\DeskTop\xxxxxxx Returns1.xlsx"
'OPEN WORKBOOK
Set objWorkBook = objExcel.Workbooks.Open (ExcelPath)
If objWorkBook is Nothing Then
MsgBox ("Could not open your Excel workbook. File:" & Excelpath)
objExcel.Quit
Stop
End If
'FORMAT COL 42 AS NUMBER
objWorkBook.Worksheets ("No Results").Columns ("AP:AP").Select
objWorkBook.Worksheets ("No Results").Columns ("AP:AP").NumberFormat = "#,##0.00;[Red](#,##0.00)"
If Not objExcel.Visible Then objExcel.Visible = True
End Sub
Thank you, Jeane
Jeane
'--------------------------------------------------------------------------------
Macro will move records from No Results to SAME or MORE after performing
' a different macro. If it states returns pulled with no ref or bal due
' and col 44 indicates empty and col23 states "no return in the cell"
'--------------------------------------------------------------------------------
Option Explicit
Dim objExcel as Object, objWorkBook as Object, scrErr as String
Dim xlRow as Integer
Declare Sub GetExcel()
Sub Main()
'-------------------------------------------------------------------------
Call GetExcel()
'-------------------------------------------------------------------------
' This section of code contains the recorded events
Dim xlNRTab, xlSMTab, objSameMoreTxt as String
Dim xl44Col as String , xl42Col, xl23Col as String, xl11Col as String
Dim xl8Col, xlMove
'SET ROW NUMBER
xlNRTab = "2"
xlSMTab = Inputbox ("Enter first available Same or More row number.")
If xlSMTab = "" Then
xlSMTab = "2"
End If
'BEGIN LOOPING THROUGH THE RECORDS
Do
doevents
'CAPTURE DATA IN THESE COLUMNS
xl42Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 42)
xl23Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 23 )
xl11Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 11 )
If (xl23Col = "TransId is not in R200") Then
If xl42col = 0 Then 'COL11 = "SAME"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)= "SAME"
xlMove = 1
ElseIf xl42col <0 Then 'COL11 = "MORE"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)= "MORE"
xlMove = 1
Elseif xl42col >0 Then 'COL11 = "LESS"
objWorkbook.Worksheets("No Results").cells(xlNRTab, 11)="Less"
xlMove = 1
End If
End If
If xlMove = 1 Then
'GET DATA FOR SAME OR MORE SHEET
objWorkBook.Worksheets("No Results").Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Copy
'PASTE IT IN SAME OR MORE SHEET
objWorkbook.Worksheets("Same or More").Select
objWorkbook.Worksheets("Same or More").Rows(xlSMTab).Select
objWorkBook.ActiveSheet.Paste
xlSMTab = xlSMTab + 1
'REMOVE IT FROM NO RESULTS
objWorkBook.Worksheets("No Results").Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Select
objWorkBook.Worksheets("No Results").Rows(xlNRTab).Delete
xlNRTab = xlNRTab - 1
End If
xl42Col = 0
xl8Col = ""
xlMove = 0
doevents
xlNRTab = xlNRTab + 1
xl8Col = objWorkbook.Worksheets("No Results").cells(xlNRTab, 8 )
Loop until xl8Col = ""
msgbox "Macro is done"
End Sub
'--------------------------------------------------------------------------
Sub GetExcel()
Dim objExcel as Object
'START EXCEL
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If objExcel is Nothing Then
Set objExcel = CreateObject("Excel.Application")
If objExcel is Nothing Then
msgBox ("Cannot open Excel.")
Stop
End If
End If
'OPEN SPREADSHEET
Dim fileName as String, ExcelPath as String, nret, r, tmpId as String
'XXXX HAS ALREADY OPENED THE TEMPLATE AND DOWNLOADED DATA. THEN DID
'SAVEAS xxxxxxx Returns1.xlsx TO THEIR DESKTOP.
'OPEN SAME FILE TO FIX 'NO RESULTS'
tmpId = InputBox("Enter your userId, e.g., (A1234)")
ExcelPath = "C:\Users\" & tmpId & "\DeskTop\xxxxxxx Returns1.xlsx"
'OPEN WORKBOOK
Set objWorkBook = objExcel.Workbooks.Open (ExcelPath)
If objWorkBook is Nothing Then
MsgBox ("Could not open your Excel workbook. File:" & Excelpath)
objExcel.Quit
Stop
End If
'FORMAT COL 42 AS NUMBER
objWorkBook.Worksheets ("No Results").Columns ("AP:AP").Select
objWorkBook.Worksheets ("No Results").Columns ("AP:AP").NumberFormat = "#,##0.00;[Red](#,##0.00)"
If Not objExcel.Visible Then objExcel.Visible = True
End Sub
Thank you, Jeane
Jeane