Adapt code to work in new file

Copper Contributor

Hello, I have a issue with a VBA code.
I'm trying to use a VBA code from other excel file to my excel file.
I think i need to adapte something in the code, but i tried and I did not succeed.
When i run the VBA code in excel nothing happens.
I pasted this code into the file of my current excel file and did not change anything.
If anyone can help me by indicating what I should change, I would greatly appreciate it.


VBA CODE:

 

Sub IBReport()
Dim TSID As Range
Dim TSList As Range
Dim SDid As Range
Dim SDList As Range
Dim ws As Worksheet
Dim AE As Boolean
Dim RTD As Boolean

' Seta o ws
Set ws = ActiveWorkbook.Worksheets(1)

'Seta TSList para percorrer toda a planilha
Set TSList = Range(ws.Range("C2"), ws.Range("C1").End(xlDown))

' Corrige coluna C e Marcar Inactive em vermelho
' Da um IF do header Tech Support pra garantir que não modificou a estrutura do report inicial
If ws.Range("D1").Value = "Tech Support" Then

For Each TSID In TSList.Cells
AE = False
RTD = False
'Substitui "C," pelas respectivas garantias conforme coluna D
If ws.Range("D" & TSID.row).Value = "PS" Or ws.Range("D" & TSID.row).Value = "PL" Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "ProSupport")
ElseIf ws.Range("D" & TSID.row).Value = "LS" Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "Premium Support")
ElseIf ws.Range("D" & TSID.row).Value = "P+" Or ws.Range("D" & TSID.row).Value = "PY" Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "PSPlus")
' Adiciona "MC", caso contenha "HR"
If InStr(1, ws.Range("C" & TSID.row).Value, "HR", vbTextCompare) > 1 And InStr(1, ws.Range("C" & TSID.row).Value, "MC", vbTextCompare) = 0 Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "PSPlus", "PSPlus MC")
End If
ElseIf ws.Range("D" & TSID.row).Value = "PSMC" Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "PSMC")
ElseIf InStr(1, ws.Range("C" & TSID.row).Value, "ADVANCED EXCHANGE", vbTextCompare) > 1 Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "")
AE = True
ElseIf InStr(1, ws.Range("C" & TSID.row).Value, "RTD", vbTextCompare) > 1 Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "Balcão")
RTD = True
ElseIf ws.Range("D" & TSID.row).Value = "" And AE = False And RTD = False Then
ws.Range("C" & TSID.row).Value = Replace(ws.Range("C" & TSID.row).Value, "C,", "Basic")
End If

If Not IsEmpty(ws.Range("F" & TSID.row).Value) And InStr(1, ws.Range("C" & TSID.row).Value, "+ CC", vbTextCompare) = 0 Then
ws.Range("C" & TSID.row).Value = ws.Range("C" & TSID.row).Value & " + CC"
End If
If Not IsEmpty(ws.Range("G" & TSID.row).Value) And InStr(1, ws.Range("C" & TSID.row).Value, "+ KK", vbTextCompare) = 0 Then
ws.Range("C" & TSID.row).Value = ws.Range("C" & TSID.row).Value & " + KK"
End If

Next TSID
End If


End Sub

1 Reply
Hi Gustavo
Could you please upload your file as an example?

I understood that macro will work if
1. in the string in the cells in column C contains "C,"
2. value in D1 = "Tech Support"
3. cell value in column D = "PS", "PL", "LS", "P+" etc
4. in cells column F and/or G is not be empty and stirng in cells in column C will not contain the string "+ CC" then it will add to the end of the string

otherwise, it will not work because will have nothing to change in cells value