multiply codes

[erdow]

Hi all,

Sub CminusO()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range("S2:S" & LastRow) = Evaluate("C2:C" & LastRow & "-O2:O" & LastRow)
End Sub

I found this code from Rick Rothstein while searching older posts and it's perfect for me but i need to multiply it.
If you can help me i would be greatful.
This code for C-O=S but I have a workbook with 5 same sheet (with 3 columns) and need to multiply this code like;
C-D=E J-K=L P-Q=R
Thanks in advance for your help.

 

[Snakehips]

@erdow
Does this help?
Currently, it does assume that all block start at same row and that you only have the 5 sheets that need to be procesed.

Sub CminusO()
Dim FirstRow, LastRow, c As Long
Dim VarRng As Range
Dim ws As Worksheet
Dim IncAdd, ExpAdd As String
Application.ScreenUpdating = False

FirstRow = 11  'Assumes that first row of values is known and constant????? eg 11

'assuming workbook only has the 5 sheets of interest ??????

For Each ws In ThisWorkbook.Sheets

c = 3  'first column of first group = C = 3

Do While c < 20
LastRow = ws.Cells(Rows.Count, c).End(xlUp).row
Set VarRng = Range(Cells(FirstRow, c + 2), Cells(LastRow, c + 2))
IncAdd = VarRng.Offset(0, -2).Address
ExpAdd = VarRng.Offset(0, -1).Address


VarRng = Evaluate(IncAdd & "-" & ExpAdd)

'Modify first column for next group
Select Case c
Case 3
c = 10
Case 10
c = 16
Case 16
c = 99   ' set high to exit do loop
End Select

Loop

Next ws

Application.ScreenUpdating = True
End Sub

 

[erdow]

@erdow
Does this help?
Currently, it does assume that all block start at same row and that you only have the 5 sheets that need to be procesed.

Sub CminusO()
Dim FirstRow, LastRow, c As Long
Dim VarRng As Range
Dim ws As Worksheet
Dim IncAdd, ExpAdd As String
Application.ScreenUpdating = False

FirstRow = 11  'Assumes that first row of values is known and constant????? eg 11

'assuming workbook only has the 5 sheets of interest ??????

For Each ws In ThisWorkbook.Sheets

c = 3  'first column of first group = C = 3

Do While c < 20
LastRow = ws.Cells(Rows.Count, c).End(xlUp).row
Set VarRng = Range(Cells(FirstRow, c + 2), Cells(LastRow, c + 2))
IncAdd = VarRng.Offset(0, -2).Address
ExpAdd = VarRng.Offset(0, -1).Address


VarRng = Evaluate(IncAdd & "-" & ExpAdd)

'Modify first column for next group
Select Case c
Case 3
c = 10
Case 10
c = 16
Case 16
c = 99   ' set high to exit do loop
End Select

Loop

Next ws

Application.ScreenUpdating = True
End Sub

Thank you so much for your interest sir.
But i think i did not explained my problem exactly because of my english
i want to share my exact file with notes but i didnt find the way to do it and changed the file extension from xlsm to jpeg
hope it works.
thanks in advance

 

[Marc L]

Hi,​

​

as you can link your workbook on a files host website like Dropbox for example …​

 

[erdow]

Hi,​

​

as you can link your workbook on a files host website like Dropbox for example …​

 

[erdow]

Thanks Marc L
I think its ok
sample.xlsm

 

[erdow]

Thanks Marc L
I think its ok
sample.xlsm

Any solution for my sample workbook?

 

[Snakehips]

@erdow
Replace your current code as below.
Copy this to the code module of each of your five branch sheets.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRw As Long
LastRw = ListObjects(1).DataBodyRange.Rows.Count + 10   'Last table row + 10
If Not Intersect(Target, Range("C11:d" & LastRw)) Is Nothing Then

Call CminusO(LastRw)
End If
End Sub

Copy this to code Module1

Sub CminusO(LastRw As Long)
 Dim LastE As Long
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
  
  LastE = Cells(Rows.Count, "E").End(xlUp).Row
  Range("e11:e" & LastE) = vbNullStr  'clear any stray E data below table if exists?
  
  Range("e11:e" & LastRw) = Evaluate("C11:C" & LastRw & "-d11:d" & LastRw)
  
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
  
End Sub

Hope that helps.

 

[erdow]

@erdow
Replace your current code as below.
Copy this to the code module of each of your five branch sheets.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRw As Long
LastRw = ListObjects(1).DataBodyRange.Rows.Count + 10   'Last table row + 10
If Not Intersect(Target, Range("C11:d" & LastRw)) Is Nothing Then

Call CminusO(LastRw)
End If
End Sub

Copy this to code Module1

Sub CminusO(LastRw As Long)
 Dim LastE As Long
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 
  LastE = Cells(Rows.Count, "E").End(xlUp).Row
  Range("e11:e" & LastE) = vbNullStr  'clear any stray E data below table if exists?
 
  Range("e11:e" & LastRw) = Evaluate("C11:C" & LastRw & "-d11:d" & LastRw)
 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 
End Sub

Hope that helps.

Its perfectly fits my need, thank you so much..
There is just one problem, if i add another line at the bottom or between existing rows of the table, it doesnt calculate.
Is it possible to solve it?

 

[Snakehips]

Its perfectly fits my need, thank you so much..
There is just one problem, if i add another line at the bottom or between existing rows of the table, it doesnt calculate.
Is it possible to solve it?

You are welcome.
I'm sorry, but it would appear to be ok for me when I add or delete rows so I do not know how to help further.