Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with code creation
I am trying to create vb code to search column 'M' of sheet 'ProCode' and
find all the rows that match the value of Me.CbxDept.text. With this data I would then like to programactilly like to copy the data cell by cell and row by row to the sheet that another code has created. The reason for copying cell by cell is due to the sheet being copied to is formatted with merged cells. This is what I have already. Private Sub BtnGo_Click() Dim WSNew As Worksheet 'Dim rng As Range 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 befo=Sheets(2) Set WSNew = ActiveSheet 'creates the name of 'WSNew' WSNew.name = T 'assigns cell 'J2' equal to 'T' WSNew.Cells(2, 10) = T 'copies all data that matches 'T' to new sheet With Application ..ScreenUpdating = True ..EnableEvents = True End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with code creation
On 24 Dec., 22:49, Mekinnik
wrote: I am trying to create vb code to search column 'M' of sheet 'ProCode' and find all the rows that match the value of Me.CbxDept.text. With this data I would then like to programactilly like to copy the data cell by cell and row by row to the sheet that another code has created. The reason for copying cell by cell is due to the sheet being copied to is formatted with merged cells. This is what I have already. Private Sub BtnGo_Click() Dim WSNew As Worksheet 'Dim rng As Range 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 befo=Sheets(2) Set WSNew = ActiveSheet 'creates the name of 'WSNew' WSNew.name = T 'assigns cell 'J2' equal to 'T' WSNew.Cells(2, 10) = T 'copies all data that matches 'T' to new sheet With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Try this Private Sub BtnGo_Click() Dim tRow() Dim WSNew As Worksheet 'Dim rng As Range 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 befo=Sheets(2) Set WSNew = ActiveSheet 'creates the name of 'WSNew' WSNew.Name = T 'assigns cell 'J2' equal to 'T' WSNew.Cells(2, 10) = T 'copies all data that matches 'T' to new sheet c = 1 Sheets("ProCode").Select Range("M1").EntireColumn.Select Selection.Find(What:=T, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ True).Activate ReDim Preserve tRow(c) tRow(c) = ActiveCell.Row Do c = c + 1 Selection.FindNext(After:=ActiveCell).Activate ReDim Preserve tRow(c) tRow(c) = ActiveCell.Row Loop Until tRow(1) = tRow(c) 'Copy cells in column A:M to WSNew Set tCell = WSNew.Range("A2") ' First destination cell For r = 1 To c - 1 For Col = 1 To 13 Cells(tRow(c), Col).Copy Destination:=tCell Set tCell = tCell.Offset(0, 1) Next Set tCell = tCell.Offset(1, -(Col - 1)) ' Next row Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Regards Per |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help with code creation
Jessen,
I managed to get the code you wrote for me to work with very little modification, however it only finds the first instance of 'T' and not the rest. If column 'M' have 20 rows of data and 5 of them begin with 'T' then it should copy all the rows, however it only copies the first 'T' however many times 'T' shows up. So if the first 'T' is A01,A02,B01,A03,D01,B02,A04...... It should copy all the rows that begin with the letter A, which it does not it will only copy the first one and copy it to however mant there are and in this case would be 4 rows of just A01. "Per Jessen" wrote: On 24 Dec., 22:49, Mekinnik wrote: I am trying to create vb code to search column 'M' of sheet 'ProCode' and find all the rows that match the value of Me.CbxDept.text. With this data I would then like to programactilly like to copy the data cell by cell and row by row to the sheet that another code has created. The reason for copying cell by cell is due to the sheet being copied to is formatted with merged cells. This is what I have already. Private Sub BtnGo_Click() Dim WSNew As Worksheet 'Dim rng As Range 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 befo=Sheets(2) Set WSNew = ActiveSheet 'creates the name of 'WSNew' WSNew.name = T 'assigns cell 'J2' equal to 'T' WSNew.Cells(2, 10) = T 'copies all data that matches 'T' to new sheet With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Try this Private Sub BtnGo_Click() Dim tRow() Dim WSNew As Worksheet 'Dim rng As Range 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 befo=Sheets(2) Set WSNew = ActiveSheet 'creates the name of 'WSNew' WSNew.Name = T 'assigns cell 'J2' equal to 'T' WSNew.Cells(2, 10) = T 'copies all data that matches 'T' to new sheet c = 1 Sheets("ProCode").Select Range("M1").EntireColumn.Select Selection.Find(What:=T, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ True).Activate ReDim Preserve tRow(c) tRow(c) = ActiveCell.Row Do c = c + 1 Selection.FindNext(After:=ActiveCell).Activate ReDim Preserve tRow(c) tRow(c) = ActiveCell.Row Loop Until tRow(1) = tRow(c) 'Copy cells in column A:M to WSNew Set tCell = WSNew.Range("A2") ' First destination cell For r = 1 To c - 1 For Col = 1 To 13 Cells(tRow(c), Col).Copy Destination:=tCell Set tCell = tCell.Offset(0, 1) Next Set tCell = tCell.Offset(1, -(Col - 1)) ' Next row Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Regards Per |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro Creation | Excel Programming | |||
Automate PDF file creation in Excel code | Excel Programming | |||
remove the row value in the pivot table creation code. | Excel Programming | |||
Streamline PivotTable creation code | Excel Programming | |||
code for creation of multiple pivot tables | Excel Programming |