Incomplete process

[Len]

Hi,


I just explore to copy the range of cells from the existing worksheet
to multiple sheets by using excel vba code but somehow the result does
not work as intended and the process was incomplete

How to eliminate the incomplete processes under excel vba code which
always appear when a new workbook is opened ?

Appreciate your help to solve this problem as I’m excel vba beginner

Thanks in advance

Regards
Len

 

[OssieMac]

Hi Len,

If I understand correctly, you have tried some code but it is not working
correctly. If so, can you post the code you have and then explain exactly
what is not completing.

 

[Len]

Hi Len,

If I understand correctly, you have tried some code but it is not working
correctly. If so, can you post the code you have and then explain exactly
what is not completing.

--
Regards,

OssieMac










- Show quoted text -

Hi OssieMac,



My intended codes are used to extract filtered range of cells based on
the inputbox entry to a new single worksheet under the same workbook,
eg. "ADP" starting with text ADP in column A and copy the whole block
of range from A2:S50 existing sheet to new sheet but it copies row by
row with text "ADP" into each row of multple sheets. That multple
processes are incomplete and hang on

Below is the extract of codes

Dim J As Integer
Dim sTarget As String
sTarget = InputBox("Enter search target")

If Len(sTarget) = 0 Then
MsgBox "Nothing to do"
Exit Sub
End If

Sheets.Add After:=Sheets(Sheets.Count)
For J = 3 To Sheets.Count ' from sheet2 to last sheet
With Worksheets("Budget")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If .Cells(i, "A").Value = sTarget Then
iNextRow = iNextRow + 1
.Rows(i).Copy Worksheets(J).Cells(iNextRow, "A")
End If
Next i
End With
Sheets(J).Columns.AutoFit
Sheets(J).Select
Sheets(J).Name = sTarget

Now, the problem is the process of this codes after execution was
incomplete and these always listed to the right click mouse when a new
workbook is opened ( ie unable to delete ) and only go off when excel
is opend in safe mode but still persist in excel normal operation

Thanks your help

Regards
Len

 

[OssieMac]

Hi Len,

Not completely confident that I fully understand but try the following and
see if it does what you want. It has validation to ensure that a valid string
is inserted and that the worksheet does not already extist. Also converts
input string to uppercase and the string being compared to uppercase in case
the user enters in lowercase.

It also copies the headers from budget sheet to new sheet.

Let me know how it goes.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

Sub Test()

Dim sTarget As String
Dim rngTarg As Range
Dim wsNew As Worksheet
Dim iLastRow
Dim i

'Convert input to uppercase
sTarget = UCase(InputBox("Enter search target"))

If Len(sTarget) = 0 Then
MsgBox "Nothing to do"
Exit Sub
End If

'Test if input string exists in column A
With Sheets("Budget")
Set rngTarg = .Columns("A") _
.Find(What:=sTarget, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
End With

'If inpput string does not exist then
'do not create new worksheet.
If rngTarg Is Nothing Then
MsgBox sTarget & " does not exist." & vbCrLf _
& "Processing terminated."
Exit Sub
End If

'Test if worksheet already exists before
'attempting to add a new one by that name
On Error Resume Next
Set wsNew = Sheets(sTarget)
If Err.Number = 0 Then
MsgBox "Sheet " & sTarget & " exists." _
& vbCrLf & "Processing terminated."
Exit Sub
End If
On Error GoTo 0 'Reset error trapping

'Add the new worksheet and name it
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = sTarget

'Assign new worksheet to a variable
Set wsNew = ActiveSheet

With Worksheets("Budget")
'copy column headers to new worksheet
.Rows(1).Copy wsNew.Cells(1, 1)

iLastRow = .Cells(.Rows.Count, "A") _
.End(xlUp).Row

'Starting row 2 assumes you have column headers
For i = 2 To iLastRow

'Convert comparison cell value to uppercase
If UCase(.Cells(i, "A").Value) = sTarget Then
.Rows(i).Copy _
wsNew.Cells(wsNew.Rows.Count, 1) _
.End(xlUp).Offset(1, 0)

End If
Next i
End With
wsNew.Columns.AutoFit
wsNew.Select

End Sub

 

[Len]

Hi Len,

Not completely confident that I fully understand but try the following and
see if it does what you want. It has validation to ensure that a valid string
is inserted and that the worksheet does not already extist. Also converts
input string to uppercase and the string being compared to uppercase in case
the user enters in lowercase.

It also copies the headers from budget sheet to new sheet.

Let me know how it goes.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

Sub Test()

Dim sTarget As String
Dim rngTarg As Range
Dim wsNew As Worksheet
Dim iLastRow
Dim i

'Convert input to uppercase
sTarget = UCase(InputBox("Enter search target"))

If Len(sTarget) = 0 Then
  MsgBox "Nothing to do"
  Exit Sub
End If

'Test if input string exists in column A
With Sheets("Budget")
  Set rngTarg = .Columns("A") _
    .Find(What:=sTarget, _
    LookIn:=xlFormulas, _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
End With

'If inpput string does not exist then
'do not create new worksheet.
If rngTarg Is Nothing Then
  MsgBox sTarget & " does not exist." & vbCrLf _
      & "Processing terminated."
      Exit Sub
End If

'Test if worksheet already exists before
'attempting to add a new one by that name
On Error Resume Next
Set wsNew = Sheets(sTarget)
If Err.Number = 0 Then
  MsgBox "Sheet " & sTarget & " exists." _
    & vbCrLf & "Processing terminated."
    Exit Sub
End If
On Error GoTo 0 'Reset error trapping

'Add the new worksheet and name it
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = sTarget

'Assign new worksheet to a variable
Set wsNew = ActiveSheet

With Worksheets("Budget")
  'copy column headers to new worksheet
  .Rows(1).Copy wsNew.Cells(1, 1)

  iLastRow = .Cells(.Rows.Count, "A") _
              .End(xlUp).Row

  'Starting row 2 assumes you have column headers
  For i = 2 To iLastRow

    'Convert comparison cell value to uppercase
    If UCase(.Cells(i, "A").Value) = sTarget Then
      .Rows(i).Copy _
        wsNew.Cells(wsNew.Rows.Count, 1) _
        .End(xlUp).Offset(1, 0)

    End If
  Next i
End With
wsNew.Columns.AutoFit
wsNew.Select

End Sub

Hi OssieMac,

Great, your codes work perfectly for each input entry
However, If we have more than one input entry, then it will take each
time to process
In this case, how to modify your codes to process for say 10 input
text "ADP", "CBUS" BIT"...., to distribute the data range into
respective worksheets under the same workbook

Thanks again

Regards
Len

 

[OssieMac]

Hi Len,

You must have thought I'd forgotten about you. The Microsoft site where I
picked up this thread has been down for a couple of days.

Anyway, how would you like to do this? Do you want a Listbox on a popup form
to make the selections or do you want to just enter them via multiple
Inputboxes? If you have xl2007 then can use AutoFilter and I can code it to
run on the selections but earlier versions of xl don't support multiple
selections in AutoFilter.

 

[Len]

Hi Len,

You must have thought I'd forgotten about you. The Microsoft site where I
picked up this thread has been down for a couple of days.

Anyway, how would you like to do this? Do you want a Listbox on a popup form
to make the selections or do you want to just enter them via multiple
Inputboxes? If you have xl2007 then can use AutoFilter and I can code it to
run on the selections but earlier versions of xl don't support multiple
selections in AutoFilter.

Hi OssieMac,

I was away for other jobs and not accessable to internet
Thanks for your kind reply !
Well, if the input text will increase as time go on and which method
will be suitable for this process
The process that I'm working on is in Excel 2003 and will need to copy
over to run another desktop pc which run on Excel 2007

Regards
Len