macro to copy Bold value

[Tintoo]

Pls help me... since am not aware of macros and now i need to complete my work faster.

lets say i have a any content (text or numbers) in range A1:H10000 in sheet 1. There is only one "BOLD" value in sheet 1. I need to copy that bold value and paste in sheet 2 of same workbook in column E. It should copy and paste in column E of sheet 2 only if there is any content in the corresponding cell in the previous column D of sheet 2. if there is no content in column D then it should not paste in column E and it should be blank or empty. I dont want to retain the format.

Thanks in advance

 

[Crystalyzer]

Sub FindCopyBoldValue()    
    Dim c As Range
    Dim r As Range
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Set wb = ActiveWorkbook
    Set ws1 = wb.Sheets(1)
    Set ws2 = wb.Sheets(2)
    Set r = ws1.UsedRange
    
    For Each c In r.Cells
        If c.Font.Bold Then
            If ws2.Cells(c.Row, 4).Value <> "" Then
                ws2.Cells(c.Row, 5).Value = c.Value
                Exit For
            End If
        End If
    Next
End Sub

 

[Tintoo]

Crystalyzer,

can u help me by editing the macro so that by which i can specify the sheet name... if i run this program the result is blank only... and i need the result in range E1:E20 and not in a single cell... pls help

 

[Tintoo]

This is my excat requirement...
I have a list of values in sheet 1 for range A1:H100. in this range there is a bold value. Now i need to paste this bold value in range E1:E20 of sheet 10 of same workbook. pls help with a macro.
Note: the value should paste in range E1:E20 of sheet 10 only if there is any value (i.e.,text or number) in the range D1:D20 of same sheet 10

 

[Rick Rothstein]

This is my excat requirement...
I have a list of values in sheet 1 for range A1:H100. in this range there is a bold value. Now i need to paste this bold value in range E1:E20 of sheet 10 of same workbook. pls help with a macro.
Note: the value should paste in range E1:E20 of sheet 10 only if there is any value (i.e.,text or number) in the range D1:D20 of same sheet 10

Give this macro a try...

Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1:H100")
    If Cell.Font.Bold Then
      If Len(Cell.Offset(, 1)) Then
        Cell.Copy Sheets("Sheet10").Range("E1:E10")
        Exit Sub
      End If
    End If
  Next
End Sub

 

[Tintoo]

Rick Rothstein,

It works too fine. Thank you so much. But i dont want to copy the cell format and i need only the value. Moreover the above macro pastes the value in the cell range which i specify like E1:E10 but i want it to paste in E1:E10 only if there is any value in before column D1:D10... if the value in D5 is empty then i dont want to paste in E5 too...

Pls help

Give this macro a try...

Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1:H100")
    If Cell.Font.Bold Then
      If Len(Cell.Offset(, 1)) Then
        Cell.Copy Sheets("Sheet10").Range("E1:E10")
        Exit Sub
      End If
    End If
  Next
End Sub

 

[Rick Rothstein]

Rick Rothstein,
It works too fine. Thank you so much. But i dont want to copy the cell format and i need only the value. Moreover the above macro pastes the value in the cell range which i specify like E1:E10 but i want it to paste in E1:E10 only if there is any value in before column D1:D10... if the value in D5 is empty then i dont want to paste in E5 too...

Give this macro a try then...

[table="width: 500"]
[tr]
	[td]Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1:H100")
    If Cell.Font.Bold Then
      Sheets("Sheet10").Range("E1:E10").Value = Evaluate("IF(D1:D10="""","""",""" & Cell.Value & """)")
      Exit Sub
    End If
  Next
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

Give this macro a try then...

[table="width: 500"]
[tr]
	[td]Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim Cell As Range
  For Each Cell In Sheets("Sheet1").Range("A1:H100")
    If Cell.Font.Bold Then
      Sheets("Sheet10").Range("E1:E10").Value = Evaluate("IF([B][COLOR="#FF0000"]Sheet10![/COLOR][/B]D1:D10="""","""",""" & Cell.Value & """)")
      Exit Sub
    End If
  Next
End Sub[/td]
[/tr]
[/table]

I forgot to include the sheet reference inside the Evaluate function (see the red text above); however, I have come up with a faster routine that does not use a loop at all...

[table="width: 500"]
[tr]
	[td]Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim CellVal As Variant
  Application.FindFormat.Clear
  Application.FindFormat.Font.Bold = True
  On Error GoTo NoBoldText
  CellVal = Sheets("Sheet1").Range("A1:H100").Find("", SearchFormat:=True).Value
  Sheets("Sheet10").Range("E1:E10").Value = Evaluate("IF(Sheet10!D1:D10="""","""",""" & CellVal & """)")
  Application.FindFormat.Clear
NoBoldText:
End Sub
[/td]
[/tr]
[/table]

 

[Tintoo]

Rick Rothstein,

It shows me some error either #name? or #ref!.. pls help...

I forgot to include the sheet reference inside the Evaluate function (see the red text above); however, I have come up with a faster routine that does not use a loop at all...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub CopyBoldValueToSheet10RangeE1ToE10()
  Dim CellVal As Variant
  Application.FindFormat.Clear
  Application.FindFormat.Font.Bold = True
  On Error GoTo NoBoldText
  CellVal = Sheets("Sheet1").Range("A1:H100").Find("", SearchFormat:=True).Value
  Sheets("Sheet10").Range("E1:E10").Value = Evaluate("IF(Sheet10!D1:D10="""","""",""" & CellVal & """)")
  Application.FindFormat.Clear
NoBoldText:
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

 

[Rick Rothstein]

Rick Rothstein,

It shows me some error either #name? or #ref!.. pls help...

I cannot duplicate that result... the code I posted in Message #8 works fine for me. I just noticed that you told us two different things in Messages #1 and #4... my code assumes the data is in Sheet1 in the range A1:H100 and the output is to go to Sheet10 range E1:E10 but only for those cells where a value is in range D1:D10 on Sheet10... is that the same as your current setup?