Macro causing column issue and memory error...

porter

New Member
Joined
May 3, 2007
Messages
19
Good morning (it is morning here in Vancouver),

I am hoping someone will have an answer for me. I have a macro setup that moves data from one worksheet to another worksheet (one tab within my workbook to another) based on data submitted via an inputbox. The code is below. The problem I am having is that, when even one row of info is transferred to the "CLOSED" tab, the sheet all of a sudden has the maximum amount of columns ("XFD", or something like that, being the last column) and I get a memory error when trying to delete that row - and I cannot, of course, "undo" the macro (so I have to close without saving and reopen or delete the columns).

Could someone have a look at this code and tell me what I have to do to eliminate the problem. I have a similar code in another workbook that does not illicit the same problem with columns when the macro is activated. Thanks...

Code:
Sub CLOSEJOB()
'
' CLOSEJOB Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
'FROM WIP
Application.ScreenUpdating = False
Dim LastRow&, SearchString$, FirstAddress$, _
    fCell As Range, dCell As Range, RecCopied%
RecCopied = 0
SearchString = InputBox(prompt:="Enter the JOB NUMBER to CLOSE", Title:="CLOSE JOB")
If SearchString = "" Then GoTo INVUSAGE
Sheets("WIP").Select
LastRow = Sheets("WIP").Cells(Rows.Count, "C").End(xlUp).Row
''//Assumes you have headers in row 1
With Sheets("WIP").Range("A7:A" & LastRow)
  Set fCell = .Find(What:=SearchString, LookIn:=xlFormulas, LookAt:=xlPart)
  If fCell Is Nothing Then
    MsgBox SearchString & " was not found in the WIP sheet.", , SearchString & " Not Found"
    GoTo INVUSAGE
  End If
  FirstAddress = fCell.Address
  Do
    Sheets("COMPLETED").Cells(Rows.Count, "C").End(xlUp)(2).EntireRow.Value = fCell.EntireRow.Value
    RecCopied = RecCopied + 1
    If dCell Is Nothing Then
      Set dCell = fCell
    Else
      Set dCell = Union(fCell, dCell)
    End If
    Set fCell = .FindNext(fCell)
  Loop While Not fCell Is Nothing And Not fCell.Address = FirstAddress
  dCell.EntireRow.Delete
  MsgBox RecCopied & " records were found and closed.", , "Success"
End With
'END OF WIP CLOSE
'FROM INVENTORY USAGE
INVUSAGE:
Sheets("INVUSAGE").Select
LastRow = Sheets("INVUSAGE").Cells(Rows.Count, "C").End(xlUp).Row
''//Assumes you have headers in row 1
With Sheets("INVUSAGE").Range("A4:A" & LastRow)
  Set fCell = .Find(What:=SearchString, LookIn:=xlFormulas, LookAt:=xlPart)
  If fCell Is Nothing Then
    MsgBox SearchString & " was not found in the INVENTORY USAGE sheet.", , SearchString & " Not Found"
    GoTo LastLine
  End If
  FirstAddress = fCell.Address
  Do
    Sheets("INVCOMPLETE").Cells(Rows.Count, "C").End(xlUp)(2).EntireRow.Value = fCell.EntireRow.Value
    RecCopied = RecCopied + 1
    If dCell Is Nothing Then
      Set dCell = fCell
    Else
      Set dCell = Union(fCell, dCell)
    End If
    Set fCell = .FindNext(fCell)
  Loop While Not fCell Is Nothing And Not fCell.Address = FirstAddress
  dCell.EntireRow.Delete
  MsgBox RecCopied & " records were found and closed.", , "Success"
End With
'END OF INVENTORY USAGE CLOSE
LastLine:
Sheets("MAIN").Select
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Watch MrExcel Video

Forum statistics

Threads
1,122,577
Messages
5,596,996
Members
414,116
Latest member
sfullnet

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
Top