problems with lines of VBA code

[sts8500man]

Thanks to some previous communications on mrexcel, I obtained some help generating the subroutine below. The only problem is that it quits working under each of the following conditions:

1. If “ABC” is not contained within Cell C7 it stops at this line of code –

.Copy wbR.Sheets(1).Range("B10")

1. If “ABC” is contained within Cell C7 it stops at this line of code --

.Range("F7").Copy wbR.Sheets(1).Range("B10")

Does anyone know what the problem is here and how I might fix it?

Sub Get_ABC_value()
'
' Get_ABC_value Macro
'

'
Const TxtToFind = "ABC"
Dim wbS As Workbook: Set wbS = Workbooks("download - source ABC.xls")
Dim wbR As Workbook: Set wbR = Workbooks("results.xlsm")
With wbS.Sheets(1)
If InStr(1, .Range("C7").Value, TxtToFind) > 0 Then
.Range("F7").Copy wbR.Sheets(1).Range("B10")
Else
.Rows(7).Insert
.Range("C7").Value = TxtToFind
With .Range("F7")
.Value = 0
.NumberFormat = "0.0"
.Copy wbR.Sheets(1).Range("B10")
End With
End If
End With
wbS.Save
wbR.Save
wbS.Close False
wbR.Close False
End Sub

 

[ranman256]

wbR.Sheets(1).Range("B10").copy
wbR.Sheets(1).Range("C44").select
activesheet.paste

 

[sts8500man]

Thank you ranman256. I will be trying your suggested solution some more, but upon first try it did not work. That may be because I am not a programmer and therefore do not know where to insert your proposed solution into my code. I am trying to do it by trial and error and will report back to you when I exhaust my knowledge of how to do it regardless of whether it works or not. Thanks again for responding.

 

[Fluff]

What error message do you get?

 

[sts8500man]

I do not get an error message. The screen just goes blank. It appears that Excel shuts down. To get back to it I have to restart it but it appears that no damage was done to any of the code. It just stops and goes blank?

 

[Fluff]

What happens if you add the parts in blue as shown

Sub Get_ABC_value()
'
' Get_ABC_value Macro
'

   [COLOR=#0000ff]With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
      .EnableEvents = False
   End With[/COLOR]
   Const TxtToFind = "ABC"
   Dim wbS As Workbook: Set wbS = Workbooks("download - source ABC.xls")
   Dim wbR As Workbook: Set wbR = Workbooks("results.xlsm")
   With wbS.Sheets(1)
      If InStr(1, .Range("C7").Value, TxtToFind) > 0 Then
         .Range("F7").Copy wbR.Sheets(1).Range("B10")
      Else
         .Rows(7).Insert
         .Range("C7").Value = TxtToFind
         With .Range("F7")
            .Value = 0
            .NumberFormat = "0.0"
            .Copy wbR.Sheets(1).Range("B10")
         End With
      End If
   End With
   wbS.Save
   wbR.Save
   wbS.Close False
   wbR.Close False
  [COLOR=#0000ff] With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
   End With
[/COLOR]
End Sub

 

[sts8500man]

Same thing. Screen goes blank and the files I am using all close. I have to X out then reload the files but no damage to them was done. It does put in the 0.00 in Cell F7, but then all goes blank.

 

[Fluff]

In that case it sounds like one of your workbooks maybe corrupt.

 

[sts8500man]

That is what I was afraid you would say. I guess I have to redo the thing from scratch. Maybe I can at least copy and paste the data into a new workbook.

Thank you for all your help and willingness to do so.

sts8500man

 

[Fluff]

Sorry we couldn't have been more help & thanks for the feedback