0

I want to copy cells of a certain colour in "Hacked" workbook to the "Official" workbook. I also want to loop across multiple sheets. Right now I am only testing on one sheet and the loop is already getting stuck.

Sub CopyBasel2()

Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")

Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")

Dim Cell As Range

For Each Cell In Hacked.Sheets("SA-CR.1(CE)").UsedRange.Cells

If Cell.Interior.Color = 13434828 Then
Official.Sheets("SA-CR.1(CE)").Range(Cell.Address).Value = Cell.Value

End If
Next Cell

Debug.Print Hacked.Sheets("SA-CR.1(CE)").Range("C10").Interior.Color

End Sub
Oliver Theseira
  • 57
  • 5
  • What does getting stuck mean? If you debug, is it going around the loop? Is it doing any copying? – Nick.Mc Aug 03 '21 at 09:38
  • I think you are looping through way too many cells, try `For Each Cell In Hacked.Sheets("A").UsedRange.Cells` or get a range of the last used row/column (read [this](https://stackoverflow.com/questions/38882321/better-way-to-find-last-used-row)). And what is `i` and `j` for? You aren't even using them in the loop. – Raymond Wu Aug 03 '21 at 09:38
  • also... your `i` and `j` variables don't do anything. Use `Cell` not `Cells` inside your loop – Nick.Mc Aug 03 '21 at 09:39
  • You can do something like `Official.Sheets("A").Range(Cell.Address)).Value = Cell.Value` to copy the corresponding value. – Raymond Wu Aug 03 '21 at 09:41
  • 1
    I assume you mean `Cell.Interior.Color` in the If-statement? `Cell` is your variable - `Cells` means *all* cells of the *Active Worksheet* - `Cells.Interior.Color` returns 0 except if all cells of the sheet have the same color. – FunThomas Aug 03 '21 at 09:54
  • @Raymond, I have edited my code above based on your feedback. Now my VBA runs but the values in my "Official" workbook aren't changing. Any idea why? – Oliver Theseira Aug 04 '21 at 02:48
  • @Nick, my Excel hangs and I would have to end it. I have amended my code above but my values aren't changing. – Oliver Theseira Aug 04 '21 at 02:51
  • 1
    You need to debug your code and, for example, check whether this line is ever true `If Cell.Interior.Color = 13434828` If it isn't fix it. If it is, find out why the next line isn't copying data. I suggest you read this first to understand how to debug code, it'll make things easier. https://www.myonlinetraininghub.com/debugging-vba-code – Nick.Mc Aug 04 '21 at 02:54
  • 1
    @Oliver I just made a quick test and it works. Step through your code and see if it ever reaches `Official.Sheets("SA-CR.1(CE)").Range(Cell.Address).Value = Cell.Value`. It may help if you update your question with the entire code, it's not clear if you set `Official` and `Hacked` properly. – Raymond Wu Aug 04 '21 at 02:57
  • I've pasted my full procedure above. It may have something to do with the "Official" workbook having protected sheets. As such, I've also tried to replace the value paste line with `Cell.Copy Official.Sheets("SA-CR.1(CE)").Range(Cell.Address).PasteSpecial` but it still doesn't work. – Oliver Theseira Aug 04 '21 at 04:18

1 Answers1

0

Thanks everyone for your guidance, I have managed to get my code to work as below, complete with a loop through an array of sheets.

The reason my earlier code couldn't work was because I was opening the "Official" file at the same time. When I closed it and ran my code, it ran smoothly. Anyone know the logic behind this?

Also, if anyone has a better/more elegant way of doing the array and the loops part, please feel free to share it.

Sub CopyBasel2()

Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")

Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")

With Hacked
Set WSArray = .Sheets(Array("SA-CR.1(CE)", "SA-CR.2(CRM.1)", "SA-CR.3(CRM.2)", "SA-CR.4(RWA)", _
                  "SA-CR.6(OBS)", "SA-CR.6.1(CD)", "SA-CR.7(Recon)"))
End With

For Each ws In WSArray
For Each Cell In Hacked.Sheets(ws.Name).UsedRange

If Cell.Interior.Color = 13434828 Then
Official.Sheets(ws.Name).Range(Cell.Address).Value = Cell.Value

End If
Next Cell
Next ws

End Sub
Oliver Theseira
  • 57
  • 5