Copy Files from One Location to Another Folder Direcory in Excel VBA

Function Ping(strip)
Dim objshell, boolcode
Set objshell = CreateObject("Wscript.Shell")
boolcode = objshell.Run("ping -n 1 -w 1000 " & strip, 0, True)
If boolcode = 0 Then
    Ping = True
Else
    Ping = False
End If
End Function
Sub PingSystem()
Dim strip As String
Dim strPhoneNumber As String
Dim strMessage As String
Dim strPostData As String
Dim IE As Object

strPhoneNumber = Sheets("DATA").Cells(2, 1).Value

For introw = 2 To ActiveSheet.Cells(65536, 2).End(xlUp).Row
    strip = ActiveSheet.Cells(introw, 2).Value
    If Ping(strip) = True Then
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Online"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(0, 200, 0)
        
'Send Whatsapp Message
        strMessage = "Ping " & ActiveSheet.Cells(introw, 1).Value & " " & ActiveSheet.Cells(introw, 2).Value & " is Online"
        
'IE.navigate "whatsapp://send?phone=phone_number&text=your_message"
        strPostData = "whatsapp://send?phone=" & strPhoneNumber & "&text=" & strMessage
        Set IE = CreateObject("InternetExplorer.Application")
        IE.navigate strPostData
        Application.Wait Now() + TimeSerial(0, 0, 3)
        SendKeys "~"

        Set IE = Nothing
        
    Else
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 3).Font.Color = RGB(200, 0, 0)
        ActiveSheet.Cells(introw, 3).Value = "Offline"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 3).Interior.ColorIndex = 6
        
'Send Whatsapp Message
        strMessage = "Ping " & ActiveSheet.Cells(introw, 1).Value & " " & ActiveSheet.Cells(introw, 2).Value & " is Offline"
        
'IE.navigate "whatsapp://send?phone=phone_number&text=your_message"
        strPostData = "whatsapp://send?phone=" & strPhoneNumber & "&text=" & strMessage
        Set IE = CreateObject("InternetExplorer.Application")
        IE.navigate strPostData
        Application.Wait Now() + TimeSerial(0, 0, 3)
        SendKeys "~"
        Set IE = Nothing
    End If
Next
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

<STRG>+J

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

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

ZEICHEN(10)

Bsp: 
=C1&ZEICHEN(10)&D1

Sub Clearcells()
'Updateby Extendoffice
Range("B8", "B12").Clear
End Sub

=ZÄHLENWENN(H$2:H$868;H2)

=ZÄHLENWENN(B2:B5;"X")

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

'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

import pandas pd

excel_file = pd.read_excel(‘file.xlsx’, sheet_name=None)
dataset_combined = pd.concat(excel_file.values())

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 

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

=LINKS(D2;FINDEN("@";WECHSELN(D2;"_";"@";LÄNGE(D2)-LÄNGE(WECHSELN(D2;"_";""))))-1)&"."&RECHTS(D2;LÄNGE(D2)-FINDEN(".";D2))

=((DAYS(U24,O24)))