Snippets Collections
Sub ColorCellsByHexInCells()
  Dim rSelection As Range, rCell As Range

  If TypeName(Selection) = "Range" Then
  Set rSelection = Selection
    For Each rCell In rSelection
      rCell.Interior.Color = WorksheetFunction.Hex2Dec(Mid$(rCell.Text, 2))
    Next
  End If
End Sub
SELECT DISTINCT VO.SKU , SUM(VO.SHIPPEDQTY) V2.DESCR AS ItemName,
FROM [SCE].vw_ORDERDETAIL_1 vo 
WHERE vo.ACTUALSHIPDATE BETWEEN '2023-01-01 00:00:00' AND '2024-01-01 00:00:00'
AND vo.STORERKEY = 'CLARINS'
AND vo.STATUS = 95
GROUP BY vo.SKU 
HAVING SUM(V1.SHIPPEDQTY) > 0


SELECT TOP 10 * 
FROM [SCE].vw_ORDERDETAIL_1 V1 
INNER JOIN SCE.vw_SKU V2 ON V1.SKU = V2.SKU 
WHERE V1.ACTUALSHIPDATE BETWEEN '2023-01-01 00:00:00' AND '2024-01-01 00:00:00'
AND V1.STORERKEY = 'CLARINS'
AND V1.STATUS = 95
Function COUNTConditionColorCells(CellsRange As Range, ColorRng As Range)
'make the worksheet always update
Application.Volatile
'define my variables

Dim Work As Boolean
Dim dbw As String
Dim CFCELL As Range
Dim CF1 As Single
Dim CF2 As Double
Dim CF3 As Long

Work = False
'for the first conditional format to the number of conditions in the range
For CF1 = 1 To CellsRange.FormatConditions.Count
    'if the first condition colour is in the range then start counting
    If CellsRange.FormatConditions(CF1).Interior.ColorIndex = ColorRng.Interior.ColorIndex Then
    Work = True
Exit For
    End If
Next CF1
CF2 = 0
CF3 = 0
If Work = True Then
For Each CFCELL In CellsRange
    'count the colours in the range
    dbw = CFCELL.FormatConditions(CF1).Formula1
    dbw = Application.ConvertFormula(dbw, xlA1, xlR1C1)
    dbw = Application.ConvertFormula(dbw, xlR1C1, xlA1, , ActiveCell.Resize(CellsRange.Rows.Count, CellsRange.Columns.Count).Cells(CF3 + 1))
    If Evaluate(dbw) = True Then CF2 = CF2 + 1
        CF3 = CF3 + 1
Next CFCELL
Else
COUNTConditionColorCells = "NO-COLOR"
Exit Function
    End If
COUNTConditionColorCells = CF2
End Function
Follow this to hide the formulaes so its not obvious 
=((DAYS(U24,O24)))
=LINKS(D2;FINDEN("@";WECHSELN(D2;"_";"@";LÄNGE(D2)-LÄNGE(WECHSELN(D2;"_";""))))-1)&"."&RECHTS(D2;LÄNGE(D2)-FINDEN(".";D2))
Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

' String representation of amount.

MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function


' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function


' Converts a number from 10 to 99 into text.


Function GetTens(TensText)

Dim Result As String

Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99...

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

End If

GetTens = Result

End Function


' Converts a number from 1 to 9 into text.

Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function
list1 = [1, 2, 3]
list2 = [4, 5, 6]

# Product part
product_for_sum = []
for i in range(0, len(list1)):
   product_for_sum.append(list1[i]*list2[i])

# Sum part
sumproduct = sum(product_for_sum)

print(sumproduct)
# (1*4) + (2*5) + (3*6)
# = 4 + 10 + 18
# = 32 
import pandas pd

excel_file = pd.read_excel(‘file.xlsx’, sheet_name=None)
dataset_combined = pd.concat(excel_file.values())
'In this Example I am Copying the File From "C:Temp" Folder to "D:Job" Folder
Sub sbCopyingAFile()

'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is Your File Name which you want to Copy
sFile = "Sample.xls"

'Change to match the source folder path
sSFolder = "C:Temp"

'Change to match the destination folder path
sDFolder = "D:Job"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "Specified File Not Found", vbInformation, "Not Found"
    
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
    MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If

End Sub
=LINKS(B3;LÄNGE(B3)-1)


Stattdessen erste 9 Zeichen entfernen:
=RECHTS(E1;LÄNGE(E1)-9)
=ZÄHLENWENN(H$2:H$868;H2)

=ZÄHLENWENN(B2:B5;"X")
Sub Clearcells()
'Updateby Extendoffice
Range("B8", "B12").Clear
End Sub
ZEICHEN(10)

Bsp: 
=C1&ZEICHEN(10)&D1
Public Sub SolveFive(Optional ShowAlert As Boolean = True)

'Purpose    : Runs Solver Loops through the '5YrChoice_MVoptions' Tab
'Author     : Jimmy Briggs <jimmy.briggs@pwc.com>
'Description: Automate Workflow for RLUS Client
'Date       : 2022-02-04

 Application.ScreenUpdating = False
 Application.DisplayStatusBar = True
 Application.Cursor = xlWait
 On Error GoTo HandleError

 Dim changeCells As Range
 Dim Result As Integer
 Dim i As Integer
 Dim StartTime As Double
 Dim SecondsElapsed As Double

 StartTime = Timer

 Application.StatusBar = "Starting Macro for 5YrChoice_MVoptions, please be patient..."

 Sheets("5YrChoice_MVoptions").Select

 For i = 3 To 62 Step 1
    Application.StatusBar = "Running Solver on iteration " & i & " out of 62."
    Set changeCells = ActiveSheet.Range(Range(Cells(i, 28).Address, Cells(i, 29).Address).Address)
    SolverReset
    SolverOptions precision:=0.000000001
    SolverOK SetCell:=Cells(i, 35).Address, MaxMinVal:=2, byChange:=changeCells.Address
    SolverAdd CellRef:=Cells(i, 36).Address, Relation:=2, FormulaText:=0
    SolverAdd CellRef:=changeCells.Address, Relation:=3, FormulaText:=0.0000000001
    Result = SolverSolve(True)

    If Result <= 3 Then
        SolverFinish KeepFinal:=1
    Else
        Beep
        MsgBox "Solver was unable to find a solution.", vbExclamation, "SOLUTION NOT FOUND"
        SolverFinish KeepFinal:=2
        GoTo Skip
    End If

Skip:
    SolverFinish KeepFinal:=2
    Next i

 Sheets("Comparison").Select
 SecondsElapsed = Round(Timer - StartTime, 2)
 Range("Latest_Execution_Time_5").Value = SecondsElapsed

 If ShowAlert = True Then
    MsgBox "Successfully ran code in " & SecondsElapsed & " seconds", vbInformation
 End If

 Application.StatusBar = "Done running Solver for sheet 5YrChoice_MVoptions."
 Application.OnTime Now + TimeValue("00:00:07"), "clearStatusBar"
 Application.ScreenUpdating = True

HandleExit:
    Application.Cursor = xlDefault
    Exit Sub
HandleError:
    MsgBox Err.Description
    Resume HandleExit

End Sub
Sub ClearData()
 
Worksheets("Clients").Rows("2:" & Rows.Count).ClearContents
Worksheets("Cases").Rows("2:" & Rows.Count).ClearContents
Worksheets("Sessions").Rows("2:" & Rows.Count).ClearContents
 
End Sub
Sub ClearData()

Worksheets("Clients").Rows("2:" & Rows.Count).ClearContents
Worksheets("Cases").Rows("2:" & Rows.Count).ClearContents
Worksheets("Sessions").Rows("2:" & Rows.Count).ClearContents

End Sub
star

Wed Aug 14 2024 09:45:11 GMT+0000 (Coordinated Universal Time) https://stackoverflow.com/questions/10455366/how-to-highlight-a-cell-using-the-hex-color-value-within-the-cell?rq

#vb #excel
star

Sun Apr 07 2024 16:50:14 GMT+0000 (Coordinated Universal Time)

#excel
star

Sun Feb 25 2024 07:10:19 GMT+0000 (Coordinated Universal Time)

#excel
star

Tue Feb 06 2024 19:08:08 GMT+0000 (Coordinated Universal Time)

#excel
star

Fri Feb 02 2024 17:46:16 GMT+0000 (Coordinated Universal Time) https://www.youtube.com/watch?v=NflzVqndxW4&t=172s

#excel
star

Tue Jan 02 2024 15:23:13 GMT+0000 (Coordinated Universal Time) https://trumpexcel.com/hide-formulas-excel/

#excel
star

Fri Dec 22 2023 16:28:45 GMT+0000 (Coordinated Universal Time)

#excel
star

Wed Jun 28 2023 09:34:51 GMT+0000 (Coordinated Universal Time)

#excel #dbfakt
star

Fri May 26 2023 15:18:27 GMT+0000 (Coordinated Universal Time) https://support.microsoft.com/es-es/office/convertir-números-en-palabras-a0d166fb-e1ea-4090-95c8-69442cd55d98

#excel
star

Tue Dec 13 2022 06:09:12 GMT+0000 (Coordinated Universal Time) https://support.microsoft.com/en-us/office/sumproduct-function-16753e75-9f68-4874-94ac-4d2145a2fd2e

#python #excel
star

Thu Sep 08 2022 07:34:52 GMT+0000 (Coordinated Universal Time) https://analysistabs.com/excel-vba/copy-files-one-location-another-folder-directory/

#vba #excel
star

Fri Jun 10 2022 08:31:24 GMT+0000 (Coordinated Universal Time)

#excel
star

Fri Jun 10 2022 06:07:27 GMT+0000 (Coordinated Universal Time) https://www.office-hilfe.com/support/threads/zaehlen-wie-haeufig-ein-wert-vorkommt.51153/

#excel
star

Thu Jun 09 2022 15:10:22 GMT+0000 (Coordinated Universal Time) https://de.extendoffice.com/documents/excel/4088-excel-button-to-clear-specific-cells.html#:~:text=Normalerweise%20k%C3%B6nnen%20Sie%20die%20halten,dann%20den%20Zelleninhalt%20nach%20Bedarf.

#excel #macro
star

Wed Jun 08 2022 09:32:51 GMT+0000 (Coordinated Universal Time) https://exceltricks.blog/mit-der-funktion-zeichen10-koennen-sie-einen-zeilenumbruch-in-einer-zelle-einfuegen/#:~:text=Mit%20der%20Funktion%20VERKETTEN(),%3DZEICHEN(10)%20erreichen.

#excel
star

Mon Feb 07 2022 18:08:40 GMT+0000 (Coordinated Universal Time)

#vba #excel
star

Wed Feb 02 2022 21:39:08 GMT+0000 (Coordinated Universal Time)

#excel #vba #macro
star

Tue Feb 01 2022 21:37:39 GMT+0000 (Coordinated Universal Time)

#excel
star

Fri Feb 26 2021 04:08:24 GMT+0000 (Coordinated Universal Time)

#excel #vba

Save snippets that work with our extensions

Available in the Chrome Web Store Get Firefox Add-on Get VS Code extension