M
Mekinnik
I need help with code to search for only the left 2 characters of all rows
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy before:=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet
NewRow = 5
With Sheets("ProCode")
Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then
'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
within a single column to use as a reference for another search code. So if
the user selects say EM from CbxDept, I want the code to find all the rows
with EM in the first 2 characters, then the second part of the code will copy
all the data to another sheet. Here is the code I have currentlly, but it
doesn't work right.
Private Sub BtnGo_Click()
Dim tRow()
Dim WSNew As Worksheet
Dim T As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'creates a new sheet from the master sheet
T = Me.CbxDept.Text
Sheets("MASTER").Copy before:=Sheets(2)
Set WSNew = ActiveSheet
'creates the name of 'WSNew'
WSNew.Name = T
'assigns cell 'J2' equal to 'T'
WSNew.Range("J2") = T
'copies all data that matches 'T' to new sheet
NewRow = 5
With Sheets("ProCode")
Lastrow = .Range("M" & Rows.Count).End(xlUp).Row
For RowCount = 2 To Lastrow
If .Range("M" & RowCount) = T Then
'Copy cells in column A:M to WSNew
Set CopyRange = .Range("A" & RowCount & ":M" & _
RowCount)
CopyRange.Copy _
Destination:=WSNew.Range("A" & NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub