• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

paste highlighted data

Plz have a look the copy and paste condition are as follows
vba is placed in seperate file
open marks.csv file
open student.xlsx file
if column c of marks.csv file matches with column a of students.xlsx file then copy the yellow colour highlighted data of that row of student.xlsx and paste it to column h of marks.csv file
save and close marks.csv file and close student.xlsx file
and paste only the data means only numbers, not the highlighted colour along with numbers
so plz have a look and do needful
 

AlanSidman

Active Member
Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.
 

p45cal

Well-Known Member
Place this code in a standard code-module of a separate file and test:
Code:
Sub blah()
pathstring = Application.GetOpenFilename(fileFilter:="All Files (* . xl*) , *.xl* ")
If pathstring = False Then
  MsgBox "No Excel file chosen, aborting…"
  Exit Sub
End If
' check if it's already open:
For Each wb In Workbooks
  If InStr(pathstring, wb.FullName) > 0 Then
    Set SceWbk = wb
    xlfound = True
    Exit For
  End If
Next wb
If Not xlfound Then Set SceWbk = Workbooks.Open(pathstring)

pathstring = Application.GetOpenFilename(fileFilter:="All Files (* . csv) , *.csv ")
If pathstring = False Then
  MsgBox "No CSV file chosen, aborting…"
  Exit Sub
End If
' check if it's already open:
For Each wb In Workbooks
  If InStr(pathstring, wb.FullName) > 0 Then
    Set DstnWbk = wb
    csvfound = True
    Exit For
  End If
Next wb
If Not csvfound Then Set DstnWbk = Workbooks.Open(pathstring)

'Set SceWbk = Workbooks("QuantitY.xlsx")
'Set DstnWbk = Workbooks("BasketOrder..csv")
Set SceSht = SceWbk.Sheets(1)
Set DstnSht = DstnWbk.Sheets(1)
Set SceRng = Intersect(SceSht.UsedRange, SceSht.UsedRange.Offset(1))
Set SymbolSearchRng = Intersect(DstnSht.Columns("C"), DstnSht.UsedRange)
For Each rw In SceRng.Rows
  For Each cll In Intersect(rw, rw.Offset(, 1)).Cells
    If cll.Interior.Color = 65535 Then
      mySymbol = rw.Cells(1).Value
      If Len(Application.Trim(mySymbol)) > 0 Then
        With SymbolSearchRng
          Set c = .Find(mySymbol, LookIn:=xlValues)
          If Not c Is Nothing Then
            FirstAddress = c.Address
            Do
              c.Offset(, 5).Value = cll.Value
              Set c = .FindNext(c)
              If c Is Nothing Then Exit Do
            Loop Until FirstAddress = c.Address
          End If
        End With
      End If

      Exit For
    End If
  Next cll
Next rw
'these next two lines only close the workbooks if they weren't already open:
If Not xlfound Then SceWbk.Close False    'no saving
If Not csvfound Then DstnWbk.Close True    'will overwrite old version if changes were made.
End Sub
It will only process the first (from the left) yellow cell in a given row.
If there is no yellow cell in a given row no updating of the corresponding row(s) of the csv file will occur.
If you want to blank cells in column H of the csv file, make sure the first yellow cell encountered is blank.
Note the comments in the code.
 
sir in this code we have to choose file
i dont want that sir
what i want is i will run the code and it should automatically do the process
in a single click process sould be completed
so plz have a look sir and do needful
 
Is it possible that there will be more than one cell highlighted in any row? If so, how to handle?
it is not possible sir there will be only one highlighted celll
 

p45cal

Well-Known Member
Code:
Sub blah2()
Set SceWbk = Workbooks.Open("QuantitY.xlsx")
Set DstnWbk = Workbooks.Open("BasketOrder..csv")
Set SceSht = SceWbk.Sheets(1)
Set DstnSht = DstnWbk.Sheets(1)
Set SceRng = Intersect(SceSht.UsedRange, SceSht.UsedRange.Offset(1))
Set SymbolSearchRng = Intersect(DstnSht.Columns("C"), DstnSht.UsedRange)
For Each rw In SceRng.Rows
  For Each cll In Intersect(rw, rw.Offset(, 1)).Cells
    If cll.Interior.Color = 65535 Then
      mySymbol = rw.Cells(1).Value
      If Len(Application.Trim(mySymbol)) > 0 Then
        With SymbolSearchRng
          Set c = .Find(mySymbol, LookIn:=xlValues)
          If Not c Is Nothing Then
            FirstAddress = c.Address
            Do
              c.Offset(, 5).Value = cll.Value
              Set c = .FindNext(c)
              If c Is Nothing Then Exit Do
            Loop Until FirstAddress = c.Address
          End If
        End With
      End If
      Exit For
    End If
  Next cll
Next rw
SceWbk.Close False    'no saving
DstnWbk.Close True    'will overwrite old version if changes were made.
End Sub
 
Top