VBA script for conditional copy, format & paste from workbook1 to workbook2

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
57
also, in new workbook , Q11111, Q22222,Q33333,Q4444 needs to be copied on B Coloumn of respective rows . [Pardon me, though i mentioned it in initial post, i missed this part in dropbox excel file. i will update.]
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
57
also, in new workbook , Q11111, Q22222,Q33333,Q4444 needs to be copied on B Coloumn of respective rows . [Pardon me, though i mentioned it in initial post, i missed this part in dropbox excel file. i will update.]
with bit of hands on, copying Q11111, Q22222,Q33333,Q4444 in B Coloumn of new workbook has been implemented & done.

however, ith column of new worksheet issue still exist.
Output on ith Column
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;

Thanks & Regards.
 
Last edited:

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
57
1 obersationi noticed

code always going to else part of if ..else, because "val.Interior.ColorIndex returning -4142" & we are checking whether it is equal to 43.
as it is not matching or equal, it is always going to else part of code.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,155
As I mentioned on Post #4 , you have to make sure that the colorindex of the shade of green you use in your cells matches the colorindex in the code. Run the following macro and change the range (in red) to a cell that is colored in green. This will display the colorindex of the shade of green you are using. Replace the "43" in the code with the displayed colorindex. That should fix the problem.
Code:
Sub test()
    MsgBox Range([COLOR="#FF0000"]"E2"[/COLOR]).Interior.ColorIndex
End Sub
 

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
57
As you said ,i used test(), got 14 as colorindex & used colorIndex as 14 in the macro you provided.
However, still the o/p remains same. it seems the value of 'val' is nothing on debug..i think it is the problem. further, it always going else part..pls check o/p.
Output on ith Column
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;
::0;;::0;;::0;;::0;;

Meanwhile, i tried a different approach..it is producing result which is 80% of my expectations. few small issues still exist. it needs to be fixed. i shared macro below.

O/P:--
A1111::0;;
B1111::1;;
C1111::0;;
D1111::0;;
A2222::0;;
B2222::0;;
C2222::1;;
D2222::0;;
A3333::0;;
B3333::0;;
C3333::0;;
D3333::1;;
A4444::1;;
B4444::0;;
C4444::0;;
D4444::0;;

<tbody>
</tbody>

Macro:
Sub writetoevv_Ultimate_Test()
Application.ScreenUpdating = False
Dim LastRow As Long, val As Range, scrWS As Worksheet, desWB As Workbook, x As Long: x = 2
Set srcws = ThisWorkbook.Sheets("Sheet1")

Dim rng As Range: Set rng = Application.Range("B1:E4")
Dim cel As Range
For Each cel In rng.Cells
With cel
For Each val In srcws.Range("B" & rng.Row & ":E" & rng.Row)
If cel.Interior.ColorIndex = 14 Then
Cells(x, 9) = cel & "::1;;"
Else
Cells(x, 9) = cel & "::0;;"
End If
Next val
x = x + 1
End With
Next cel

Application.ScreenUpdating = True


End Sub
 
Last edited:

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,155
Click [URL="https://app.box.com/s/5qh1fz8qz0kpuju59ouleh1vulthg9d7"]here [/URL]to download your file. It seems to be working properly for me.

Code:
Sub writetoevv()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, val As Range, scrWS As Worksheet, desWB As Workbook, x As Long: x = 2
    Set srcws = ThisWorkbook.Sheets("Sheet1")
    LastRow = srcws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set desWB = Workbooks.Add
    For Each rng In srcws.Range("A1:A" & LastRow)
        Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = rng
        For Each val In srcws.Range("B" & rng.Row & ":E" & rng.Row)
            If val.Interior.ColorIndex = 14 Then
                Cells(x, 9) = Cells(x, 9) & val & "::1;;"
            Else
                Cells(x, 9) = Cells(x, 9) & val & "::0;;"
            End If
        Next val
        x = x + 1
    Next rng
    Application.ScreenUpdating = True
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,155
This is what I got.
<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:251px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >Q11111</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >A1111::0;;B1111::1;;C1111::0;;D1111::0;;</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Q22222</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >A2222::0;;B2222::0;;C2222::1;;D2222::0;;</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >Q33333</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >A3333::0;;B3333::0;;C3333::0;;D3333::1;;</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >Q4444</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >A4444::1;;B4444::0;;C4444::0;;D4444::0;;</td></tr></table> <br />Excel Tabellen im Web darstellen - Excel Jeanie Html 4
 

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
57
yes, that is correct format..appreciates..

donot know why im getting w/o values..i used ur vba script as it is except commenting following line..' LastRow = srcws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ...instead i used a static value of 5/10..but it didnt worked for me

could you share ur macro enabled excel sheet with me..pls
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,155
Click the link in Post #16 for the file. You shouldn't have to change any line in the macro.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,102,200
Messages
5,485,309
Members
407,494
Latest member
RachelBuckland

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top