User:
Hej igen

Du har tidligere hjulpet mig med en makro i Excel, som jeg viser nederst og den fungerer meget fint!

Her prøver jeg at forklare, hvad “vi” allerede har, og hvilken udbygning, jeg ønsker din hjælp til.

Makroen tilbyder en rulleliste/drop down-liste i kolonne K, hvor den henter de mulige værdier i kolonne N. Det er supergodt! Jeg ved ikke, om du mener, vi skal udbygge den, eller hvad der er bedst at gøre. Det er årsagen til, at jeg viser den her.

I kolonne G skriver jeg et ID på mine direkte aner. På forhånd har jeg også listet alle de direkte aner, jeg på nuværende tidspunkt kender. De findes i kolonne B. I kolonne A har jeg bare skrevet ordet ”Ja” ud for alle de direkte aner.

Ved hjælp af fx denne indeks og sammenlign: =INDEKS(A:A;SAMMENLIGN(G996;B:B;0)) i kolonne H henter jeg ordet ”Ja” fra kolonne A. Dvs. hvis jeg i kolonne H har ”Ja” ved jeg, at det er en direkte ane. Dem formaterer jeg med lidt farve, så de er lette at se. På dansk kalder vi formateringen fra Excel for ”Bemærk”.

Problemet er: Når jeg ønsker at analysere filen ved fx at sortere værdierne lidt, er det som om, formateringen hænger ved cellen og ikke værdien. Jeg mener: Hvis jeg fx sorterer efter en dato fra kolonne L, så er det ikke længere den rigtige formatering. Hvis jeg fx har formateret E996:H996 med ”Bemærk” så er det stadig disse celler, der er formaterede, også selvom der ikke længere efter sorteringen står en direkte ane i række 996.

Det er lidt svært at forklare. Forstår du, hvad jeg mener?

Nu kunne jeg godt tænke mig, at formateringen ikke afhænger af rækken men af indholdet i kolonne H.

Kan det lade sig gøre?

Herunder finder du den makro, “vi” allerede har:

Private Sub Worksheet_Change(ByVal Target As Range)
‘Code by Sumit Bansal from https://trumpexcel.com
‘ To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 11 And Target.Row > 1 And Target.Row < 5001 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = “” Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = “” Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & “, ” & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

ChatGPT:
Forstår godt problemet med formatering, der ikke følger med værdien ved sortering. I Excel er celleformatering standardmæssigt knyttet til cellen og ikke værdien i cellen, hvilket kan være frustrerende i nogle situationer som den, du beskriver.

En måde at løse dette på er at bruge en VBA-makro, der automatisk genanvender formateringen baseret på værdien i kolonne H. Dette kunne laves sådan, at hver gang værdierne i kolonnen ændrer sig (f.eks. ved sortering), tjekkes der for “Ja” i kolonne H, og den tilhørende række formateres passende.

Her er et forslag til, hvordan dette kan implementeres:

vba

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim rng As Range

‘ Din eksisterende kode kan være her

‘ Tjekker kun kolonne H for ændringer
If Not Intersect(Target, Columns(“H”)) Is Nothing Then
Set rng = Intersect(Target, Columns(“H”))

‘ Gennemgår alle ændrede celler i kolonne H
For Each cell In rng
If cell.Value = “Ja” Then
‘ Formaterer cellerne fra E til H i den pågældende række
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = RGB(255, 255, 0) ‘ Gul baggrund
Else
‘ Fjerner formatering
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = xlNone
End If
Next cell
End If

‘ Gendanner event håndtering
Application.EnableEvents = True
End Sub

Denne makro vil køre, når der sker ændringer i kolonne H. Hvis en celle i kolonne H ændres til “Ja”, vil den tilsvarende række fra E til H få en gul baggrund. Hvis værdien ændres til noget andet, vil formateringen blive fjernet.

Du kan tilføje denne del til din eksisterende Worksheet_Change makro, eller lave det som en separat makro, afhængigt af hvad der passer bedst til din brug.

Håber det hjælper!

User
Tusind tak. Jeg tester og vender tilbage til dig.

ChatGPT
Det lyder godt! Tag dig endelig den tid, du har brug for til at teste det, og vend tilbage, hvis du har flere spørgsmål eller støder på problemer. God fornøjelse! 😊

User
Hvis jeg nu vil implementere dit forslag i den eksisterende makro, hvordan skal hele makroen så se ud (jeg er ikke god til VBA)

ChatGPT

Selvfølgelig, her er din eksisterende makro kombineret med den nye del, der håndterer formatering baseret på værdien i kolonne H:

VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Dim cell As Range
Dim rng As Range

Application.EnableEvents = True
On Error GoTo Exitsub

‘ Din eksisterende kode for kolonne K
If Target.Column = 11 And Target.Row > 1 And Target.Row < 5001 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else
If Target.Value = “” Then
GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = “” Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & “, ” & Newvalue
Else
Target.Value = Oldvalue
End If
End If
End If
End If
End If

‘ Ny kode for at håndtere formatering i kolonne H
If Not Intersect(Target, Columns(“H”)) Is Nothing Then
Set rng = Intersect(Target, Columns(“H”))
For Each cell In rng
If cell.Value = “Ja” Then
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = RGB(255, 255, 0) ‘ Gul baggrund
Else
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = xlNone
End If
Next cell
End If

Exitsub:
Application.EnableEvents = True
End Sub

Sub UpdateYellowBackgrounds()
Dim cell As Range
Dim LastRow As Long

LastRow = Cells(Rows.Count, “H”).End(xlUp).Row

For Each cell In Range(“H2:H” & LastRow)
If cell.Value = “Ja” Then
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = RGB(255, 255, 0)
Else
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = xlNone
End If
Next cell
End Sub

Indsæt denne samlede makrokode i din VBA-editor ved at erstatte den eksisterende Worksheet_Change makro. Dette skulle kombinere funktionaliteten af din eksisterende drop-down listehåndtering i kolonne K med den nye formateringshåndtering i kolonne H.

Håber det hjælper!

User
Fedt! Jeg tester

ChatGPT
Fantastisk! God fornøjelse med testningen, og tøv ikke med at vende tilbage, hvis du har yderligere spørgsmål eller støder på nogle udfordringer. 😊

User
Jeg tror, det fungerer super fint! Mange tak. Nu har jeg to udfordringer:

1) Jeg lavede en test, der viste, at de fik gul baggrund. Men der var også nogle streger omkring cellerne, jeg skulle have væk, derfor formaterede jeg alt tilbage til “Normal”.

2) Hvordan kører jeg bare makroen og får alle de gule felter tilbage?

ChatGPT
Fantastisk at høre, at det ser ud til at fungere!

Angående de uønskede streger omkring cellerne: De kan være et resultat af en tidligere formatering. Du kan fjerne dem ved at vælge de relevante celler, gå til fanen “Startside”, og under “Skrift” finde og klikke på ikonet for kantlinjer (det ligner en lille firkant med streger rundt om). Her kan du vælge “Ingen kantlinje”.

For at køre makroen på alle eksisterende celler i kolonne H og dermed få de gule felter tilbage, kan du tilføje en lille rutine til din eksisterende kode eller køre en separat makro, der går igennem alle rækkerne og tjekker værdierne i kolonne H. Her er et eksempel på, hvordan en sådan separat makro kunne se ud:

vba

Sub UpdateYellowBackgrounds()
Dim cell As Range
Dim LastRow As Long

LastRow = Cells(Rows.Count, “H”).End(xlUp).Row

For Each cell In Range(“H2:H” & LastRow)
If cell.Value = “Ja” Then
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = RGB(255, 255, 0)
Else
Range(“E” & cell.Row & “:H” & cell.Row).Interior.Color = xlNone
End If
Next cell
End Sub

Du kan indsætte denne makro i samme VBA-modul som din eksisterende Worksheet_Change makro. Efter du har gjort det, kan du køre UpdateYellowBackgrounds manuelt for at opdatere de gule felter baseret på værdierne i kolonne H.

User
Det fungerer helt fantastisk. Tusind tak for hjælpen.

ChatGPT
Det var så lidt, jeg er rigtig glad for at høre, at det fungerer for dig! Hvis du har flere spørgsmål eller støder på nye udfordringer, er du altid velkommen til at vende tilbage.

God fornøjelse med dit Excel-projekt! 😊

 

 

---

Har du kommentarer til artiklen?

Så er jeg glad for at modtage dem i relation til artiklen, dvs. i artiklens kommentarfelt herunder, ikke på Facebook og ikke via Messenger. Jeg svarer dig også relation til artiklen, ikke på Facebook og ikke via Messenger. Det skyldes, at kommentarer og artiklen jo ellers dekobles, og så er din kommentar ikke noget værd i fremtiden. Det er ærgerligt for os begge.

Hvis du ikke tidligere har kommenteret en af mine artikler her på siden, skal din kommentar først godkendes (spamhensyn). Min responstid er under normale omstændigheder meget kort. Herefter vil du stryge lige igennem.