A couple of minor optimisations:

#! perl -slw
use strict;
use Data::Dump qw[ pp ];

my %names = map{
    my( $name, $rest ) = split;
    $name, { map{ $_, undef } split ',', $rest };
} <DATA>;

my @sortedKeys = sort keys %names;

print "\t", join "\t", @sortedKeys;
for my $i ( @sortedKeys ) {
    my @keysI = keys %{ $names{ $i } };

    printf "%s\t", $i;
    for my $j ( @sortedKeys ) {

        my $nMatchingCitiesJ = grep{
            exists $names{ $j }{ $_ }
        } @keysI;

        printf "%d\t", @keysI - $nMatchingCitiesJ;
    }
    print '';
}

__DATA__
Name1  USA,Canada,Yemen
Name2  Canada,Portugal,India
Name3  China,HongKong,Canada
Name4  London,Amsterdam,Ireland,USA
Name5  India,USA,Canada
[download]