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

writetoevv

Board Regular
Joined
Mar 9, 2012
Messages
71
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
In workBook1, i have five columns (A,B,C,D,E) with data. Here, each row is a separate record & is going have unique data.
sample data is given below.

A B C D E
1 Q1 A1 A2 A3 A4
2 Q2 B1 B2 B3 B4

In workBook1, when i execute a VBA script , the following needs to done sequentially.
1. First, create a new workbook (for example workbook2). and, steps 2 to 6 should be repeated for all rows of workbook 1.
2. value Q1 of workbook1 should be copied to B2 in workbook2
3. if value A1 cell is in green color, then value A1::1;; should be add/appended to I2 column in workbook2. Else, append A1::0;; to I2 column of workbook2.
4. if value A2 cell is in green color, then value A2::1;; should be appended to I2 column of workbook2. Else, append A2::0;; to I2 column of workbook2.
5 if value A3 cell is in green color, then value A3::1;; should be appended to I2 column of workbook2. Else, append A3::0;; to I2 column of workbook2.
6. if value A4 cell is in green color, then value A4::1;; should be appended to I2 column of workbook2. Else, append A4::0;; to I2 column of workbook2.
7. Save workbook2 & close workbook2.

Example: for your reference, I2 Column Workbook2 should be like below.
chandu::1;;Shekar::0;;Raju::0;;Gopal::0;;
Venkat::0;;Gopi::1;;Stephen::0;;minda::0;;

<tbody>
</tbody>

<tbody>
</tbody>

<tbody>
</tbody>
 
thanks..it is working perfectly..Thanks you!!

but when i manually copy & paste #16 vba code in to a macro, while running macro, my excel has been reporting below issue on that particular line. strange.

Runtime Error - 91

Object variable or with block variable not set..
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
My apologies. I just noticed a typo (in red) in my macro. Try the following version:
Code:
Sub writetoevv()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, val As Range, [COLOR="#FF0000"]srcWS[/COLOR] 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
    Columns("I").AutoFit
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
though i updated srcWS, srcWS still showing above error..i think i need to flush cache of excel..
all other variable default values are good , except our friend srcWS..:biggrin:
let me restart my machine too..
 
Upvote 0
Hi Mumps,

You made my day..Thank you very much..

Thanks & Regards
Vishy
 
Upvote 0
Dear mumps,

my excel file may contain either english or Telugu language.
in MS excel workbooks/sheets, 0809 means English (U.K.), 0409 means English (U.S.), 044A to Telugu language.
using our macro, copy pasting english language text has no issues.
where as, if my content is telugu language, our macro could not able to copy content in a correct format.
please see attached snapshot.

https://www.dropbox.com/s/ov2ij6tnbbmhrd3/Language translate problem.jpg?dl=0

any suggestion on this.

Note:if u search for "Specifying a Language for the TEXT Function" in google, u may find a link for English (U.K.), 0409 means English (U.S.), 044A to Telugu language.
 
Last edited:
Upvote 0
To be honest, I don't know why it's not working. The macro doesn't refer to any text in any language, it uses the cell color index. Can you upload a copy of your file in your language?
 
Upvote 0
Click here for your file. I colored some of cells and you can see that the macro worked properly.
Code:
Sub writetoevv()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, val As Range, srcWS 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("A2: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
    Columns("I").AutoFit
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Hi mumps,

due to certain requirement of further process, i have been converted newly created workbook as excel csv format(Microsoft Office Excel Comma Separated Values File (.csv)). csv file has been created via vba code. issue has been coming because of that.

if i save it as an excel file(Microsoft Office Excel Worksheet (.xlsx)), i donot see any issue.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

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