BobtBuilder
New Member
- Joined
- Sep 1, 2023
- Messages
- 45
- Office Version
- 365
- Platform
- Windows
Hi folks,
I so do appreciate all the help you have given me on this project and I am on the homestretch.
I have a table which i copy certain information based on dates and create a second table, i manipulate that table and would like it to update the original table
each record has a unique identifier.
here is the code I am using(not working) It is ugly as I have been trying many different things and has become quite convoluted.
Option Explicit
Dim RecID As Long, RecDBRow As Long, RecRow As Long, LastRecRow As Long, TransDBRow As Long, LastTransRow As Long, LastResultRow As Long, ResultRow As Long
Dim AcctName As String
Dim WSName As String
Dim ws As Worksheet
Dim TargetCell As Range
Dim StDate As Date
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh1 As String
Dim LastTransRow As Long
Dim FilteredData As Range
Dim LastResultRow As Long
Dim tbl As ListObject
Dim sourceCell As Range
Dim destinationSheet As Worksheet
Dim destinationTable As ListObject
Dim destinationRow As ListRow
Dim DestDate As Range
Dim strIn As String
Dim rec As String
Dim myList As Range, myRange As Range, rw As Range, m As Variant
strIn = UCase$(InputBox("This will Update the Bank Continue Y/N"))
' Check if the user wants to continue (Y)
If strIn = "Y" Then
Set TargetCell = Dashboard.Range("G8")
' Get the value from the target cell as a string
WSName = CStr(TargetCell.Value)
On Error Resume Next
Set ws = ThisWorkbook.Sheets(WSName)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet named '" & WSName & "' does not exist"
Exit Sub
End If
rec = "yes" ' to bypass option
With ws
LastTransRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Last Trans Row in Column A
End With
' Copy the filtered data back to the original "ws" worksheet
LastResultRow = Dashboard.Cells(Dashboard.Rows.Count, 4).End(xlUp).Row 'Last Result Row in Dashboard
Set FilteredData = Dashboard.Range("D31:M" & LastResultRow)
' Set tbl = Dashboard.ListObjects("Rec_table") ' Change to your table's name
Set tbl = Dashboard.ListObjects("RecTable")
' Copy the filtered data back to the original "ws" worksheet
'FilteredData.Copy Destination:=ws.Range("A2:J2")
Set myList = Sheets("Dashboard").Range("D31:M" & LastResultRow)
Set myRange = Sheets(WSName).Range("A2:J" & LastTransRow)
For Each rw In myList.Rows
'Find match on sheet1
m = Application.Match(rw.Cells(20).Value, myRange.Columns(10), 0)
If Not IsError(m) Then
'Got a match: replace in ColB
myRange.Cells(m, 6).Value = rw.Cells(4).Value
Sheets("DashBoard").Cells(rw.Row, 9).Copy Destination:=Sheets(WSName).Cells(m, 6)
End If
Next rw
' Clear the filter in Dashboard
If ws.AutoFilterMode Then
ws.ShowAllData
End If
' If ActiveSheet.FilterMode = True Then
' ActiveSheet.ShowAllData
' End If
End Sub
Any help would be appreciated
I so do appreciate all the help you have given me on this project and I am on the homestretch.
I have a table which i copy certain information based on dates and create a second table, i manipulate that table and would like it to update the original table
each record has a unique identifier.
here is the code I am using(not working) It is ugly as I have been trying many different things and has become quite convoluted.
Option Explicit
Dim RecID As Long, RecDBRow As Long, RecRow As Long, LastRecRow As Long, TransDBRow As Long, LastTransRow As Long, LastResultRow As Long, ResultRow As Long
Dim AcctName As String
Dim WSName As String
Dim ws As Worksheet
Dim TargetCell As Range
Dim StDate As Date
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh1 As String
Dim LastTransRow As Long
Dim FilteredData As Range
Dim LastResultRow As Long
Dim tbl As ListObject
Dim sourceCell As Range
Dim destinationSheet As Worksheet
Dim destinationTable As ListObject
Dim destinationRow As ListRow
Dim DestDate As Range
Dim strIn As String
Dim rec As String
Dim myList As Range, myRange As Range, rw As Range, m As Variant
strIn = UCase$(InputBox("This will Update the Bank Continue Y/N"))
' Check if the user wants to continue (Y)
If strIn = "Y" Then
Set TargetCell = Dashboard.Range("G8")
' Get the value from the target cell as a string
WSName = CStr(TargetCell.Value)
On Error Resume Next
Set ws = ThisWorkbook.Sheets(WSName)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet named '" & WSName & "' does not exist"
Exit Sub
End If
rec = "yes" ' to bypass option
With ws
LastTransRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Last Trans Row in Column A
End With
' Copy the filtered data back to the original "ws" worksheet
LastResultRow = Dashboard.Cells(Dashboard.Rows.Count, 4).End(xlUp).Row 'Last Result Row in Dashboard
Set FilteredData = Dashboard.Range("D31:M" & LastResultRow)
' Set tbl = Dashboard.ListObjects("Rec_table") ' Change to your table's name
Set tbl = Dashboard.ListObjects("RecTable")
' Copy the filtered data back to the original "ws" worksheet
'FilteredData.Copy Destination:=ws.Range("A2:J2")
Set myList = Sheets("Dashboard").Range("D31:M" & LastResultRow)
Set myRange = Sheets(WSName).Range("A2:J" & LastTransRow)
For Each rw In myList.Rows
'Find match on sheet1
m = Application.Match(rw.Cells(20).Value, myRange.Columns(10), 0)
If Not IsError(m) Then
'Got a match: replace in ColB
myRange.Cells(m, 6).Value = rw.Cells(4).Value
Sheets("DashBoard").Cells(rw.Row, 9).Copy Destination:=Sheets(WSName).Cells(m, 6)
End If
Next rw
' Clear the filter in Dashboard
If ws.AutoFilterMode Then
ws.ShowAllData
End If
' If ActiveSheet.FilterMode = True Then
' ActiveSheet.ShowAllData
' End If
End Sub
Any help would be appreciated