Mar 10 2021 08:11 PM
When i press the run button Target.Address = "$B$6" Then cell is update to trigger the below code.
I have been using below code which i run first time it copies the cell value from sht2 B4 and paste into sht3 B4.
2nd time runs the code it copies the sht2 Q4 and paste into sht3 C4.
3rd time runs the code it copies the sht2 B4 and paste into sht3 D4.
4th time runs the code it copies the sht2 B4 and paste into sht3 E4.
5th time runs the code it copies the sht2 B4 and paste into sht3 F4.
6th time runs the code it copies the sht2 B4 and paste into sht3 G4.
7th time runs the code it copies the sht2 Q4 and paste into sht3 H4.
8th time runs the code it copies the sht2 B4 and paste into sht3 I4. and it is working perfectly i have attached a workbook which can be download and might be better for understanding.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$6" Then
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim col As Long
Set sht2 = Sheets("Sheet2")
Set sht3 = Sheets("Sheet3")
col = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 1
If col = 3 Or 8 Then
sht2.Cells(4, 17).copy
Else
sht2.Cells(4, 2).copy
End If
sht3.Cells(4, col).PasteSpecial xlPasteValues
End If
End Sub
and i want same thing for 2nd Table that is
1st time runs the code it will copy the sht2 F4 and paste into sht3 L4
2nd time runs the code it will copy the sht2 U4 and paste into sht3 M4
3rd time runs the code it will copy the sht2 F4 and paste into sht3 N4
4th time runs the code it will copy the sht2 F4 and paste into sht3 O4
5th time runs the code it will copy the sht2 F4 and paste into sht3 P4
6th time runs the code it will copy the sht2 F4 and paste into sht3 Q4
7th time runs the code it will copy the sht2 U4 and paste into sht3 R4
8th time runs the code it will copy the sht2 F4 and paste into sht3 S4
so i tried and make below piece of code and added it with above code, where code for 1st table was working fine but 2nd Table is not updating the values and no error occurs.
col2 = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 13
If col2 = 13 Or col2 = 18 Then
sht2.Cells(4, 21).copy
Else
sht2.Cells(4, 6).copy
End If
sht3.Cells(4, col2).PasteSpecial xlPasteValues
Any help to solve the problem will be greatly appreciated.
Mar 11 2021 02:41 AM
SolutionThe two parts of the code interfere with each other because they write to the same row.
The first time you run the code, the first part of the code writes a value to column B in row 4 of Sheet3. This changes the last used column to B, so the second part of the code uses a different column than you expect: column O instead of column L (2+13 = 15).
When you run the code again, the last column is O, so the first part writes to column P, and the second part of the code writes to column AC (16+13 = 29).
Here is an improved version:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim col As Long
If Target.Address = "$B$6" Then
Set sht2 = Sheets("Sheet2")
Set sht3 = Sheets("Sheet3")
'For 1st Table
col = sht3.Cells(4, 10).End(xlToLeft).Column + 1
If col = 10 Then
MsgBox "You have used up all 8 positions for table 1!", vbExclamation
Else
If col = 3 Or col = 8 Then
sht3.Cells(4, col).Value = sht2.Cells(4, 17).Value
Else
sht3.Cells(4, col).Value = sht2.Cells(4, 2).Value
End If
End If
'For 2nd Table
col = Application.Max(sht3.Cells(4, 20).End(xlToLeft).Column + 1, 12)
If col = 20 Then
MsgBox "You have used up all 8 positions for table 2!", vbExclamation
Else
If col = 13 Or col = 18 Then
sht3.Cells(4, col).Value = sht2.Cells(4, 21).Value
Else
sht3.Cells(4, col).Value = sht2.Cells(4, 6).Value
End If
End If
End If
End Sub
Mar 11 2021 02:54 AM
Mar 11 2021 04:44 AM
Mar 11 2021 05:37 AM
Change the macro CellVal (the macro called by the command button on Sheet3) to:
Sub CellVal()
Dim sht1 As Worksheet
Dim ECell As Range
Dim r As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("B4:S4").ClearContents
Application.EnableEvents = True
Set sht1 = Sheets("Sheet1")
Set ECell = sht1.Cells(6, 2)
For r = 27 To 34
If sht1.Cells(r, 3).Value <> "" Then
ECell.Value = sht1.Cells(r, 3).Value
End If
Next r
Application.ScreenUpdating = True
End Sub
Mar 11 2021 05:51 AM
Mar 11 2021 02:41 AM
SolutionThe two parts of the code interfere with each other because they write to the same row.
The first time you run the code, the first part of the code writes a value to column B in row 4 of Sheet3. This changes the last used column to B, so the second part of the code uses a different column than you expect: column O instead of column L (2+13 = 15).
When you run the code again, the last column is O, so the first part writes to column P, and the second part of the code writes to column AC (16+13 = 29).
Here is an improved version:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim col As Long
If Target.Address = "$B$6" Then
Set sht2 = Sheets("Sheet2")
Set sht3 = Sheets("Sheet3")
'For 1st Table
col = sht3.Cells(4, 10).End(xlToLeft).Column + 1
If col = 10 Then
MsgBox "You have used up all 8 positions for table 1!", vbExclamation
Else
If col = 3 Or col = 8 Then
sht3.Cells(4, col).Value = sht2.Cells(4, 17).Value
Else
sht3.Cells(4, col).Value = sht2.Cells(4, 2).Value
End If
End If
'For 2nd Table
col = Application.Max(sht3.Cells(4, 20).End(xlToLeft).Column + 1, 12)
If col = 20 Then
MsgBox "You have used up all 8 positions for table 2!", vbExclamation
Else
If col = 13 Or col = 18 Then
sht3.Cells(4, col).Value = sht2.Cells(4, 21).Value
Else
sht3.Cells(4, col).Value = sht2.Cells(4, 6).Value
End If
End If
End If
End Sub