updating a macro code

Dartit

New Member
Joined
Apr 17, 2018
Messages
5
Hiya and happy new year.

I recieved excellent help with my macro code last year, and i have dissected the code to see if i could not learn how it works and to an extent i have managed to :)

However, I am struggeling to add inn new code into the existing one. I want to add inn bold font for the titles in TitlB when the new sheets are created and i would like for the cells to autofit in the new sheets created when the macro is run.

Macro code i have:

Sub SerieNR()


Dim Ws As Worksheet
Dim Ary As Variant
Dim i As Long, j As Long
Dim Cl As Range
Dim UsdRws As Long
Dim TitlA As Variant
Dim TitlB As Variant
Dim FName As String
Dim FPath As String


Application.ScreenUpdating = False


TitlA = Array("identifikator", , "Opprett/endre utstyr", , "Mottaksbekreftelse")
TitlB = Array("Modell", "Produkt nr", "serie nr", "Materiell nr", "Mottatt dato", "lager kode")
Set Ws = Sheets("Data")
FPath = "\\mil.no\L\FMA IKT LEVKOORD REALISERING\02 IKT-ATEA\SAP REGISTRERING\Rapporter Fra Atea\02_Materielltransaksjon"
FName = Ws.Range("E2").Text
ThisWorkbook.SaveAs Filename:=FPath & "" & FName

If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
UsdRws = Ws.Range("C" & Rows.Count).End(xlUp).Row
With CreateObject("scripting.dictionary")
For Each Cl In Ws.Range("C2:C" & UsdRws)
If Not .exists(Cl.Value) Then
.Add Cl.Value, Nothing
If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
Sheets(Cl.Text).Range("A1:E1").Value = TitlA
Sheets(Cl.Text).Range("A2:F2").Value = TitlB
End If
Ws.Range("A1:D1").AutoFilter 3, Cl.Value
Ary = Ws.Range("A2:D" & UsdRws).SpecialCells(xlVisible)
j = UBound(Ary, 2)
For i = 1 To UBound(Ary, 1)
Sheets(Cl.Text).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 1)
Sheets(Cl.Text).Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 2)
Sheets(Cl.Text).Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(Ary(i, j)).Value = Ary(i, 3)
Next i
Ary = ""
End If
Next Cl
End With
Ws.AutoFilterMode = False
Ws.Activate
Ws.Delete


End Sub

Thank you very much for the time and help in this matter.
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

kvsrinivasamurthy

Well-known Member
Joined
Nov 6, 2013
Messages
642
Add This line as below
Code:
[COLOR=#333333]Sheets(Cl.Text).Range("A2:F2").Value = TitlB[/COLOR]
[COLOR=#333333]End If[/COLOR]
as
Code:
[COLOR=#333333]Sheets(Cl.Text).Range("A2:F2").Value = TitlB
[/COLOR][COLOR=#ff0000]Sheets(Cl.Text).Range("A2:F2").Font.Bold = True[/COLOR]
[COLOR=#333333]End If[/COLOR]
 
Last edited:

Dartit

New Member
Joined
Apr 17, 2018
Messages
5
Hiya

Thank you for reply.

I added the line Sheets(C1.Text).Range("A2:F2").Font.Bold = True , however when i run the code i get object required erros 424.
Im unsure why i recieve this erros as the object is C1.Text, as i understand it.

Thank you for your time.
 

Dartit

New Member
Joined
Apr 17, 2018
Messages
5
Ah, figured it out.

Cheers now it works perfectly.

Again thank you very much for your time and help :)
 

Watch MrExcel Video

Forum statistics

Threads
1,108,448
Messages
5,523,043
Members
409,494
Latest member
Itsmeerc

This Week's Hot Topics

Top