VBA Copy Value Method not working

[DeanP]

In my code the copy values line does not work:

 Worksheets("Journal").Range("E7").Value = Worksheets("Allocation %").Range("B7").Value

I don't now why? I really just want the value in col B to be copied in "Journals" starting at E7. Currently only E7 has a value when the macro is run. Possibly a problem with my ranges?

Private Sub PrepareJournal()
Dim LastCol As Long, x As Long, i As Long
Dim LastRow As Long
Dim rng As Range

    Application.ScreenUpdating = False
    With Worksheets("Journal")
        Rows("7:" & Rows.Count).ClearContents
    End With
    
    With Worksheets("Volume Allocation")
        LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column
        x = 1
        
        For i = 5 To LastCol
            If .Cells(7, i).Value <> 0 Then
                Sheets("Journal").Cells(x, "D").Value = .Cells(8, i).Value
                x = x + 16
            End If
        Next i
    End With
    
    With Worksheets("Allocation %")
        Set rng = .Range("C7:C34")
        LastRow = .Range(Split(.Cells(, rng.Column).Address, "$")(1) & (rng.Row + rng.Rows.Count)).End(xlUp).Row
            
            For i = 1 To LastRow
                If .Cells(1, i).Value <> 0 Then
                    Worksheets("Journal").Range("E7").Value = Worksheets("Allocation %").Range("B7").Value
                End If
            Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

[akuini]

Maybe:

If .Cells(1, i).Value <> 0 Then
                    Worksheets("Journal").Range("E7").Value = Worksheets("Allocation %").Range("B7").Value
                End If

change the red part to:

If .Cells(i, 1).Value <> 0

[Kenneth Hobs]

First off, i in

If .Cells(1, i).Value <> 0 Then

means column i. Did you instead want?

If .Cells(i, "A").Value <> 0 Then

Likewise, if you don't want E7 to have the value of B7 but rather the row i and not 7 then:

Worksheets("Journal").Cells(i,"E") = .Cells(i, "B")

[DeanP]

Thank you both. I still have the same problem.
n my lookup sheet ("Allocation %") in cols E & F starting from row 7 through row 34 I have values:
ColE ColF
25 37.47
81 17.77
86 4.29
83 3.36
100 0
101 3.01
102 13.44
103 5.33
104 4.39
105 1.12
106 3.20
107 0
109 0
113 1.22
116 1.11
Where column F is not zero the value in Col B on the same row must be copied over to worksheet "Journal".
Only E7 is being copied. All other rows in "Journal" are empty.

[rlv]

Change

    With Worksheets("Journal")
        Rows("7:" & Rows.Count).ClearContents
    End With

to

    With Worksheets("Journal")
        .Rows("7:" & .Rows.Count).ClearContents
    End With

so you do not clear the wrong worksheet

[rlv]

Thank you both. I still have the same problem.
n my lookup sheet ("Allocation %") in cols E & F starting from row 7 through row 34 I have values:
ColE ColF
25 37.47
81 17.77
86 4.29
83 3.36
100 0
101 3.01
102 13.44
103 5.33
104 4.39
105 1.12
106 3.20
107 0
109 0
113 1.22
116 1.11
Where column F is not zero the value in Col B on the same row must be copied over to worksheet "Journal".
Only E7 is being copied. All other rows in "Journal" are empty.

The data you posted above would not fill rows 7 - 34 per your description. It is only enough for rows 7 -21.

If you parse col F from rows 7 - 21 you will find 12 non-zero values, which presumably means 12 values in col B to be copied to Journal cell E7. Coping multiple values to a single cell (E7) makes little sense, since the final result in E7 will always be the last "B" row value. I feel like a more complete explanation is needed.

Perhaps you could post a workbook to using the data above in sheet "Allocation %" and then manually edit sheet "Journal" to show how you visualize the results of the macro to look.

[DeanP]

First, I have only given a sample of data in my post. Second, the value to be copied is in col E of "Allocation %" sheet.
This value must be copied in col E starting at row 7 of "Journal" sheet but only if the value in col F of "Allocation %" is not
zero.
Attached file shows desired outcome.

[Kenneth Hobs]

Sub Main()  
  Dim r As Range, c As Range, tf As Boolean, rr As Range
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  
  With Worksheets("Allocation %")
    Set r = .Range("E1", .Cells(Rows.Count, "E").End(xlUp))
  End With
  
  For Each c In r
    If c.Offset(, 1) <> 0 Then
      If Not tf Then
        tf = True
        Set rr = c
        Else
        Set rr = Union(rr, c)
      End If
    End If
  Next c
  
  If tf Then rr.Copy Worksheets("Journal").[E7]
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.CutCopyMode = False
End Sub

[大灰狼1976]

Hi DeanP!
sorry, if sheets("Allocation %").range("F1") is 0, will get the wrong result.

Sub test()
Dim rng As Range
Set rng = Sheets("Allocation %").Range("e1:f" & Sheets("Allocation %").[f65536].End(3).Row)
Application.ScreenUpdating = False
rng.AutoFilter Field:=2, Criteria1:=">0"
Application.Index(rng, , 1).Copy Sheets("Journal").[e7]
rng.AutoFilter
Application.ScreenUpdating = True
End Sub

[Kenneth Hobs]

The autofilter method works fine except in the case where your data starts in row 1.

Here is #9 code to make copy/paste easier.

Sub test()  
  Dim rng As Range
  
  Set rng = Sheets("Allocation %").Range("e1:f" & _
    Sheets("Allocation %").[f65536].End(3).Row)
    
  Application.ScreenUpdating = False
  
  rng.AutoFilter Field:=2, Criteria1:=">0"
  Application.Index(rng, , 1).Copy Sheets("Journal").[f7]
  rng.AutoFilter
  
  Application.ScreenUpdating = True
End Sub

[DeanP]

The autofilter method works fine except in the case where your data starts in row 1.

Here is #9 code to make copy/paste easier.

Sub test()  
  Dim rng As Range
  
  Set rng = Sheets("Allocation %").Range("e1:f" & _
    Sheets("Allocation %").[f65536].End(3).Row)
    
  Application.ScreenUpdating = False
  
  rng.AutoFilter Field:=2, Criteria1:=">0"
  Application.Index(rng, , 1).Copy Sheets("Journal").[f7]
  rng.AutoFilter
  
  Application.ScreenUpdating = True
End Sub

This copies cells with a value of zero, which is not correct. Cells with zero value should be excluded.

[Kenneth Hobs]

This copies cells with a value of zero, which is not correct. Cells with zero value should be excluded.

That is incorrect. Apparently, you did not test the code.

It is a mute point though as I explained. Most people don't put data into row 1 either.

[DeanP]

That is incorrect. Apparently, you did not test the code.

It is a mute point though as I explained. Most people don't put data into row 1 either.

Actually I did test it. In my post above I do state:

This value must be copied in col E starting at row 7 of "Journal"

. I changed the range E1:F to E7:F and then it does work, except that it places an empty cell at the end, and the reason for that is that the total in E35 returns the empty cell as its not equal to zero.
I have a question about why the last row is being found, because the range in sheet "Allocation %" is a fixed range that won't change ("E7:F34"). Aside from that, and if E1 is changed, then it does work. Thank you for your help.

[Kenneth Hobs]

As I said, it is a mute point since my solution in #8 "works". My #8 solution only needs E1 changed to E7 for your production version.

Most don't use a static ending row. If you have a static range, then make this change to make it even more concise and fit your production version needs:

Set rng = Sheets("Allocation %").[E7:F34]

The 2nd solution method using autofilter can be coded to filter out blank and 0 value rows. Since your production version does not start at row 1, the issue that I explained in #10 can be resolved. If you want to see that solution for kicks, just post back. With large amounts of data, autofilter methods are usually faster than most others.

I still can not reproduce your problem in #11 using the #7 file using the autofilter method. As I said though, that method needs some more tweaks to address your production file's data values and data location.

Of course if you just need values and not copy, and especially so for a static range, a formula array method "may" suffice. Of course with that method, your formula array has to span the same number of rows. With both 0 and empty value criterion, I don't know that I would pursue that method myself.
For giggles, here is the revised autofilter method for your production version.

Sub Test_Autofilter()  
  Dim rng As Range
  
  Set rng = Sheets("Allocation %").[E6:F34]
    
  Application.ScreenUpdating = False
  
  rng.AutoFilter 2, ">0", xlAnd, "<>"
  Application.Index(rng.Offset(1), , 1).Copy _
    Sheets("Journal").[E7]
  rng.AutoFilter
  
  Application.ScreenUpdating = True
End Sub