Excel 2021 vba 7.1 - formula in table in destination worksheet is being deleted when values are transferred to adjacent cells from source worksheet

BrerRabbit

Board Regular
Joined
Aug 20, 2023
Messages
84
Office Version
  1. 2021
  2. 2016
  3. 2013
Platform
  1. Windows
I'm copying a number of values from the source worksheet to the table in the destination worksheet using the following code:

VBA Code:
Select Case intDCol1
        Case 11 To 28
            Do While intDCol1 <= intDCol2
                Set rngSource = wsSource.Cells(141, intSCol)
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                rngDestGCL.Value = rngSource.Value
                intDCol1 = intDCol1 + 1
                intSCol = intSCol + 1
            Loop
This code is working.

The only problem is that the formulas in the adjacent cells in that row of the destination table are being deleted, even though I'm not copying values to the cells with the formulas in them.

VBA Code:
     Case 29, 31, 36, 38
            intDCol1 = intDCol1 + 1
            intSCol = intSCol + 1

I'm trying to use the following code to copy the formula from the cell above it but that isn't working either:

VBA Code:
  intDRowLessl = intDRow - 1
  Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
  Set rngDestGCLLess1Row = wsDestGCL.Cells(intDRowLessl, intDCol1)
  rngDestGCL.Formula = rngDestGCLLess1Row.Formula

Various examples from various forums suggest using the following code, but I'm unsure how to translate from R1C1 to Cell coding:

VBA Code:
Dim lngLastRow as Long 'declare a variable for the last row

  lngLastRow = Range("F" & Rows.Count).End(xlUp).Row
  Range("G6:G" & lngLastRow).FillDown

How do I resolve this? Thank you in advance.
 
I suggest you check your code: that is not the syntax you are using.

And again, step through your code. It will never touch any part of the Select Case clause other than the first Case block. If the code works as intended, you would not be having the problems you are.
 
Upvote 0

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
As Rory has alreay pointed out the code is not doing what you think its doing.
intDCol1 is set to 11, so it is going to do the first case statement.
Inside that case statement it is going to loop through intDCol1 until it hits intDCol2 which is set to 41.
So the entire set of columns from 11 to 41 are performed inside the first case statement.

It is never going to circle back to the Select Case statement so the other cases will never be peformed.

Rich (BB code):
    intDRow = wsSource.Range("G138").Value
    intSRow = wsSource.Range("E141").Value
    intDCol1 = 11
    intDCol2 = 41
    intSCol = 6

    intRow = Range("G138").Value2
 
    Select Case intDCol1                                           ' first pass indDCol1 = 11
        Case 11 To 28                                               ' so it is going to do this
            Do While intDCol1 <= intDCol2                           ' it it going to do this loop 31 times until intDCol1 = 41 being the value of intDCol2
                Set rngSource = wsSource.Cells(141, intSCol)
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                rngDestGCL.Value = rngSource.Value
                intDCol1 = intDCol1 + 1
                intSCol = intSCol + 1
            Loop
intSCol = intSCol + 1 acts as a counter. It counts through the columns in the source worksheet.
inDCol1 = intDCol1 + 1 acts as a counter. intDCol2 is the upper limit. These are column numbers of the destination table.

If the code didn't work then the data from AJ141 in the source worksheet wouldn't end up in AO20 in the destination table.

I literally just tested it again, the values are going where they are supposed to go. There are a possible 29 values being transferred, but 4 that aren't supposed to. These are values 29, 31, 36 and 38, where the formulas are in the destination table. Those cells are having the formula deleted with a blank cell.
 
Upvote 0
It's very hard to help when you refuse to accept what we are telling you. Please step through the code, or at least put breakpoints in each of these Case blocks:

VBA Code:
       Case 29, 31, 36, 38
            intDRowLessl = intDRow - 1
            Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
            Set rngDestGCLLess1Row = wsDestGCL.Cells(intDRowLessl, intDCol1)
            rngDestGCL.Formula2R1C1 = rngDestGCLLess1Row.Formula2R1C1
            
            'Sheet9.Cells(intDRow, intDCol1).Formula = Sheet9.Cells(intDRow - 1, intDCol1).Formula
        
            intDCol1 = intDCol1 + 1
            intSCol = intSCol + 1
        Case 30, 37
            Set rngSource = wsSource.Cells(141, intSCol)
            Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
            rngDestGCL.Value = rngSource.Value
            intDCol1 = intDCol1 + 1
            intSCol = intSCol + 1
        Case 32 To 35
            Do While intDCol1 <= intDCol2
                Set rngSource = wsSource.Cells(141, intSCol)
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                rngDestGCL.Value = rngSource.Value
                intDCol1 = intDCol1 + 1
                intSCol = intSCol + 1
            Loop
        Case 39 To 41
            Do While intDCol1 <= intDCol2
                Set rngSource = wsSource.Cells(141, intSCol)
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                rngDestGCL.Value = rngSource.Value
                intDCol1 = intDCol1 + 1
                intSCol = intSCol + 1
            Loop

None of them will ever be reached when the code runs.
 
Upvote 0
I suggest you check your code: that is not the syntax you are using.

And again, step through your code. It will never touch any part of the Select Case clause other than the first Case block. If the code works as intended, you would not be having the problems you are.
ok. so now i have to eat humble pie and admit that i was possibly not correct. alright i was **** wrong. I have to go back and figure the code. I honestly thought that it was working. thanks for sticking at it and trying to get it through to a blockhead such as myself.

Back to the ol drawing board.
 
Upvote 0
It may be that you just need to put the select case inside a for loop so that it branches based in the column number at each iteration?
 
Upvote 0
but 4 that aren't supposed to. These are values 29, 31, 36 and 38,
That's because these are the only 4 that are actually doing something different. You could bundle all the others into the same select case branch and they would work.

Maybe give this a try:

Rich (BB code):
Private Sub lblUpdateFutureAndScheduledChores_Click()

Dim intRow As Integer, intColumn As Integer, intLastColumn As Integer
Dim rngSource As Range
Dim rngDestGD As Range, rngDestGCL As Range, rngDestGCLLess1Row As Range
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDestGCL As Worksheet, wsDestGD As Worksheet
Dim intDRow  As Integer, intDRowLessl As Integer, intDCol1 As Integer, intDCol2 As Integer, intSCol As Integer
Dim intSRow As Integer, intSColumn As Integer, intFRow As Integer, intFColumn As Integer, intCount As Integer
Dim strMessage As String

    Set wb = ThisWorkbook
    Set wsSource = wb.Sheets("Veggie Sheets")
    Set wsDestGCL = wb.Sheets("Garden Chores List")
    Set wsDestGD = wb.Sheets("Garden Diary")
    
    wsSource.Range("H4").Select
    
    strMessage = "This will take a few moments"
    wsSource.Range("H4").Value = strMessage
    
    'update one off future chores
    If intFColumn <> "55555" Then
        Sheet1.Range("F136:N136").Value = Sheet1.Range("F38:N38").Value
        intCount = 1
        intSRow = 136
        intSColumn = 6
        intFRow = Range("J50").Value2
        intFColumn = Range("J51").Value2
        
        Do While intCount <= 9
            Set rngSource = wsSource.Cells(intSRow, intSColumn)
            Set rngDestGD = wsDestGD.Cells(intFRow, intFColumn)
            rngDestGD.Value = rngSource.Value
            intSColumn = intSColumn + 1
            intFColumn = intFColumn + 1
            intCount = intCount + 1
        Loop
    End If
        
    intDRow = wsSource.Range("G138").Value
    intSRow = wsSource.Range("E141").Value
    intDCol1 = 11
    intDCol2 = 41
    intSCol = 6

    intRow = Range("G138").Value2
    
    Do While intDCol1 <= intDCol2
        Select Case intDCol1
            Case 11 To 28, 30, 37, 32 To 35, 39 To 41
                Set rngSource = wsSource.Cells(141, intSCol)
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                rngDestGCL.Value = rngSource.Value
            Case 29, 31, 36, 38
                intDRowLessl = intDRow - 1
                Set rngDestGCL = wsDestGCL.Cells(intDRow, intDCol1)
                Set rngDestGCLLess1Row = wsDestGCL.Cells(intDRowLessl, intDCol1)
                rngDestGCL.Formula2R1C1 = rngDestGCLLess1Row.Formula2R1C1
                
                'Sheet9.Cells(intDRow, intDCol1).Formula = Sheet9.Cells(intDRow - 1, intDCol1).Formula
        End Select
        intDCol1 = intDCol1 + 1
        intSCol = intSCol + 1
    Loop
    
    strMessage = "Completed"
    wsSource.Range("H4").Value = strMessage
    Sheet1.Range("E2").Select

End Sub
 
Upvote 0
I do apologise. I honestly thought that the code worked, and it didn't. I've got it to work now but only after listening to you. I just added another loop around the select case AND changed the do while <= to the required numbers.

Thanks for sticking with me, I appreciate it. I'm a blockhead. YOU have the patience of a saint. Thank you.
 
Upvote 0
Don't worry - we've all been "code blind" from time to time and only see the code we think is there. :)
 
Upvote 0
I just added another loop around the select case AND changed the do while <= to the required numbers.
Did you consider simplifying it down to this (per my post #16) ?

1725021174433.png
 
Upvote 0
Solution

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top